Prompt to overwrite
 

The portion of code below courtesy of Debra Dalgliesh(thanks again)
pastes data into cells B1:Z1.
The problem I have is that it will overwrite existing data. I realise
that the destination cells need testing and if data exists prompt the
user (by messagebox?) for confirmation to overwrite/cancel.
I would appreciate any help in achieving this.

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
ws2.Range(ws2.Cells(2, col + 1), _
ws2.Cells(LastRow, col + 1)).Copy _
Destination:=ws.Cells(2, i + 1)
Exit For
End If
Next

TIA
Karen

Prompt to overwrite
 

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
set rng = ws2.Range(ws2.cells(2,col+1), _
ws2.Cells(LastRow,Col+1))
set rng1 = ws.Cells(2,i+1).Resize(rng.rows.count,rng.columns. count)
if application.countA(rng1) 0 then
res = msgbox "Overwrite", vbYesNo
if res = vbYes then
rng.Copy _
Destination:=ws.Cells(2, i + 1)
end if
Exit For
End If
Next


--
Regards,
Tom Ogilvy


"Karen" wrote in message
om...
The portion of code below courtesy of Debra Dalgliesh(thanks again)
pastes data into cells B1:Z1.
The problem I have is that it will overwrite existing data. I realise
that the destination cells need testing and if data exists prompt the
user (by messagebox?) for confirmation to overwrite/cancel.
I would appreciate any help in achieving this.

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
ws2.Range(ws2.Cells(2, col + 1), _
ws2.Cells(LastRow, col + 1)).Copy _
Destination:=ws.Cells(2, i + 1)
Exit For
End If
Next

TIA
Karen

Prompt to overwrite
 

Tom
Thank you very much for taking the time and trouble to reply. I am
very grateful.
I had a couple of problems running this.
I was able to sort the missing brackets in following sentence -
res = msgbox "Overwrite", vbYesNo
but for some reason I kept getting a Block If without End If with the
rest of the code.
I tinkered about ie adding/removing the If statements without result.
The original complete code is below - thanks again for replying.

Sub GetMonthAmts()
Dim i As Integer
Dim wbMaster As Workbook
Dim wbMth As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim strEmp As String
Dim col As Integer
Dim LastRow As Integer
LastRow = 50

i = InputBox("Please enter the Month number")
Set wbMaster = Workbooks("EmpMaster.xls")
Set wbMth = Workbooks("EmpMonthExp.xls")

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
ws2.Range(ws2.Cells(2, col + 1), _
ws2.Cells(LastRow, col + 1)).Copy _
Destination:=ws.Cells(2, i + 1)
Exit For
End If
Next
Next

End Sub






"Tom Ogilvy" wrote in message ...
For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
set rng = ws2.Range(ws2.cells(2,col+1), _
ws2.Cells(LastRow,Col+1))
set rng1 = ws.Cells(2,i+1).Resize(rng.rows.count,rng.columns. count)
if application.countA(rng1) 0 then
res = msgbox "Overwrite", vbYesNo
if res = vbYes then
rng.Copy _
Destination:=ws.Cells(2, i + 1)
end if
Exit For
End If
Next


--
Regards,
Tom Ogilvy


"Karen" wrote in message
om...
The portion of code below courtesy of Debra Dalgliesh(thanks again)
pastes data into cells B1:Z1.
The problem I have is that it will overwrite existing data. I realise
that the destination cells need testing and if data exists prompt the
user (by messagebox?) for confirmation to overwrite/cancel.
I would appreciate any help in achieving this.

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
ws2.Range(ws2.Cells(2, col + 1), _
ws2.Cells(LastRow, col + 1)).Copy _
Destination:=ws.Cells(2, i + 1)
Exit For
End If
Next

TIA
Karen