• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help with IF VBA

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

rngDesttwo_Offset(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

rngDesttwo_Offset(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

rngDesttwo_Offset(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

rngDesttwo_Offset(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

rngDesttwo_Offset(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
 
Hi ,


Please note that a macro is as good as a formula , since it is implementing logic in a prescribed language.


Code which is short can certainly be debugged , but beyond a certain stage debugging by reading through the code is time-consuming ; I do not know how many people will be interested in investing a lot of time in this.


You can make others' job easier if you post the complete workbook with the labelled sheet tabs , ranges , sample values etc. Debugging in this situation is easier since the code can be executed as-is , and any errors can be investigated.


Without the workbook , troubleshooting code on its own is tedious , especially when it is not indented.


Can you do something ?


Narayan
 
Hi All ,

In case anyone is interested to troubleshoot the posted macro , it is indented below :

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
rngDesttwo_Offset(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
rngDesttwo_Offset(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
rngDesttwo_Offset(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
rngDesttwo_Offset(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
rngDesttwo_Offset(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

Narayan
 
Hi ,


Just use any file-sharing website of your choice to upload your file ( such as Rapidshare , Skydrive , Googledocs , Dropbox ) ; I prefer a site such as speedy.sh , since it does not need any registration to either upload or download files.


Once you upload your file , ensure that others have permission to download and open your file , and then post the access link in this topic.


Narayan
 
Hi Secret,


Further to Narayan's instructions, below here is the link for all file sharing services listed in this forum.You can refer the same to upload the workbook...


http://chandoo.org/forums/topic/posting-a-sample-workbook


Kaushik
 
Back
Top