Secret Chimpanzee
New Member
Hi,
I am using Excel 2007 and really need help with the below code. The code works fine when separate but not when it's consolidated via an IF statement.
FYI - I have posted this problem on Mr Excel (http://www.mrexcel.com/forum/excel-questions/660970-nested-if-statements-visual-basic-applications.html) but have not received any replies (it's been about 2 days) and I really need some help with this.
Below is the code (the part that's stuck is from 'looks for Thane data' onwards - below the last "Else"):
Sub CopyCTData()
'
' CopyCTData Macro
'
Dim Yesterday As String
Dim wsCTD As Worksheet
Dim rngCTD As Range
Dim wsNM As Worksheet
Dim ws As Worksheet
Dim rngDest As Range
Dim rngDesttwo As Range
Dim r As Long
Dim rngThane As Range
Dim rngMakati As Range
Dim rngAiroli As Range
Dim rngOnshore As Range
Dim rngAlabang As Range
Yesterday = Format(Date - 1, "d-mmm")
Set wsCTD = Sheets("Call Type Data")
Set wsNM = Sheets("No Match Found")
Set wsPrevious = Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value)
'Loop from row 2 to the last used row
For r = 2 To wsCTD.Range("A" & Rows.Count).End(xlUp).Row Step 9
'Match 'Yesterday' date column on 'Call Type Data'
Set rngCTD = wsCTD.Rows(r).Find(What:=Yesterday, LookIn:=xlValues)
If rngCTD Is Nothing Then
'No date match
Application.Goto wsCTD.Rows(r)
MsgBox "Cannot match Date: " & Yesterday & " on 'Call Type Data'.", , "Date Not Found in Row: " & r
Exit Sub
End If
' Test if Destination worksheet exists
On Error Resume Next
Set ws = Nothing
' Destination worksheet name
Set ws = Sheets(wsCTD.Range("A" & r).Value)
On Error GoTo 0
If ws Is Nothing Then
'Destination worksheet does not exist
' Copy unmatched worksheet data to sheet "No Match" next empty row
wsCTD.Rows(r).Resize(10).Copy Destination:=wsNM.Range("A" & Rows.Count).End(xlUp).Offset(1)
Else
'Destination worksheet exists
' Search Row 8 for Yesterday's date
' Offset 6 rows and paste data
'Match date on destination worksheet
Set rngDest = ws.Rows(8).Find(What:=Yesterday, LookIn:=xlValues)
Set rngDesttwo = wsPrevious.Rows(8).Find(What:=Yesterday, LookIn:=xlValues)
If Not rngDest Is Nothing Then
On Error Resume Next
'Copy-paste data values
rngDest.Offset(6).Resize(8).Value = rngCTD.Offset(1).Resize(8).Value
wsCTD.Rows("2:10").EntireRow.Delete
Else
'looks for Thane data
Set rngThane = wsCTD.Rows(r).Find(What:="Thane", LookIn:=xlValues)
If Not rngThane Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(31).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Makati data
Set rngMakati = wsCTD.Rows(r).Find(What:="Makati", LookIn:=xlValues)
If Not rngMakati Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(19).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Airoli data
Set rngAiroli = wsCTD.Rows(r).Find(What:="Airoli", LookIn:=xlValues)
If Not rngAiroli Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(37).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Onshore data
Set rngOnshore = wsCTD.Rows(r).Find(What:="On Shore", LookIn:=xlValues)
If Not rngOnshore Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(43).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Alabang data
Set rngAlabang = wsCTD.Rows(r).Find(What:="Alabang", LookIn:=xlValues)
If Not rngAlabang Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(25).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
End If
End If
Next r
' Clear rows on 'Call Type Data'
'wsCTD.Range("A2", wsCTD.Range("A" & Rows.Count).End(xlUp)).EntireRow.ClearContents
MsgBox "Data copy complete. ", , "Done"
End Sub
I am using Excel 2007 and really need help with the below code. The code works fine when separate but not when it's consolidated via an IF statement.
FYI - I have posted this problem on Mr Excel (http://www.mrexcel.com/forum/excel-questions/660970-nested-if-statements-visual-basic-applications.html) but have not received any replies (it's been about 2 days) and I really need some help with this.
Below is the code (the part that's stuck is from 'looks for Thane data' onwards - below the last "Else"):
Sub CopyCTData()
'
' CopyCTData Macro
'
Dim Yesterday As String
Dim wsCTD As Worksheet
Dim rngCTD As Range
Dim wsNM As Worksheet
Dim ws As Worksheet
Dim rngDest As Range
Dim rngDesttwo As Range
Dim r As Long
Dim rngThane As Range
Dim rngMakati As Range
Dim rngAiroli As Range
Dim rngOnshore As Range
Dim rngAlabang As Range
Yesterday = Format(Date - 1, "d-mmm")
Set wsCTD = Sheets("Call Type Data")
Set wsNM = Sheets("No Match Found")
Set wsPrevious = Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value)
'Loop from row 2 to the last used row
For r = 2 To wsCTD.Range("A" & Rows.Count).End(xlUp).Row Step 9
'Match 'Yesterday' date column on 'Call Type Data'
Set rngCTD = wsCTD.Rows(r).Find(What:=Yesterday, LookIn:=xlValues)
If rngCTD Is Nothing Then
'No date match
Application.Goto wsCTD.Rows(r)
MsgBox "Cannot match Date: " & Yesterday & " on 'Call Type Data'.", , "Date Not Found in Row: " & r
Exit Sub
End If
' Test if Destination worksheet exists
On Error Resume Next
Set ws = Nothing
' Destination worksheet name
Set ws = Sheets(wsCTD.Range("A" & r).Value)
On Error GoTo 0
If ws Is Nothing Then
'Destination worksheet does not exist
' Copy unmatched worksheet data to sheet "No Match" next empty row
wsCTD.Rows(r).Resize(10).Copy Destination:=wsNM.Range("A" & Rows.Count).End(xlUp).Offset(1)
Else
'Destination worksheet exists
' Search Row 8 for Yesterday's date
' Offset 6 rows and paste data
'Match date on destination worksheet
Set rngDest = ws.Rows(8).Find(What:=Yesterday, LookIn:=xlValues)
Set rngDesttwo = wsPrevious.Rows(8).Find(What:=Yesterday, LookIn:=xlValues)
If Not rngDest Is Nothing Then
On Error Resume Next
'Copy-paste data values
rngDest.Offset(6).Resize(8).Value = rngCTD.Offset(1).Resize(8).Value
wsCTD.Rows("2:10").EntireRow.Delete
Else
'looks for Thane data
Set rngThane = wsCTD.Rows(r).Find(What:="Thane", LookIn:=xlValues)
If Not rngThane Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(31).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Makati data
Set rngMakati = wsCTD.Rows(r).Find(What:="Makati", LookIn:=xlValues)
If Not rngMakati Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(19).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Airoli data
Set rngAiroli = wsCTD.Rows(r).Find(What:="Airoli", LookIn:=xlValues)
If Not rngAiroli Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(37).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Onshore data
Set rngOnshore = wsCTD.Rows(r).Find(What:="On Shore", LookIn:=xlValues)
If Not rngOnshore Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(43).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
'looks for Alabang data
Set rngAlabang = wsCTD.Rows(r).Find(What:="Alabang", LookIn:=xlValues)
If Not rngAlabang Is Nothing Then
On Error Resume Next
Sheets(ThisWorkbook.Worksheets("ChangeWorksheets").Range("ChangeWorksheetsPreviousWorksheetName").Value).Select
rngDesttwffset(25).Resize(2).Value = rngCTD.Offset(1).Resize(2).Value
Application.CutCopyMode = False
End If
End If
End If
Next r
' Clear rows on 'Call Type Data'
'wsCTD.Range("A2", wsCTD.Range("A" & Rows.Count).End(xlUp)).EntireRow.ClearContents
MsgBox "Data copy complete. ", , "Done"
End Sub