VBA code testing
-
-
-
Re: VBA code testing
Testing quote
QuoteSub MYTest()
Dim x as Long
for x = 1 to 5
debug.print x
next x
End Sub -
-
-
-
-
-
-
Re: VBA code testing
Code
Display MoreSub TestMultiLine() Dim x As String x = "test" '// Comment after code Rem full line comment '// full line comment Dim i As Integer i = 10 Rem (this shouldn't comment) '// comment with another apostrophe (') in here Select Case i Case Is < 5: y = "less is more" '<~~ extra spaces are deliberate Case 10: y = "equals" End Select End Sub
-
Re: VBA code testing
Code
Display MoreSub TestMultiLine() Dim x As String x = "test" '// Comment after code Rem full line comment '// full line comment Dim i As Integer i = 10 Rem (this should-not be comment) test$ = "Rem in text" test = test & "other" '// Rem in comment '// comment with another apostrophe (') in here Select Case i Case Is < 5: y = "less is more" '<~~ extra spaces are deliberate Case 10: y = "equals" End Select End Sub
-
Re: VBA code testing
Quote from Dave Hawley;769602Code
Display MoreSub TestMultiLine() Dim x As String x = "test" '// Comment after code Rem full line comment '// full line comment Dim i As Integer i = 10 Rem (this should-not be comment) '// comment with another apostrophe (') in here Select Case i Case Is < 5: y = "less is more" '<~~ extra spaces are deliberate Case 10: y = "equals" End Select End Sub
Rem in middle of line will turn the line red
-
-
Re: VBA code testing
these lines should not be red
Code
Display MoreSub sannuk7() Dim NewWs As Worksheet Dim lrow As Long Dim i As Long Dim ws As Integer Dim StrtD As Integer Dim EndD As Integer Dim Cell1 As Range StrtD = Application.InputBox("Please insert start year", "Start Year", "2000") EndD = Application.InputBox("Please insert end year", "End Year", Year(Now)) Application.ScreenUpdating = False On Error Resume Next Application.DisplayAlerts = False Sheets("Summary").Delete Application.DisplayAlerts = True Set NewWs = Worksheets.Add(After:=Sheets(Sheets.Count)) NewWs.Name = "Summary" For ws = 1 To Sheets.Count If Left(Sheets(ws).Name, 4) >= StrtD And Left(Sheets(ws).Name, 4) <= EndD Then Sheets(ws).Columns(1).Copy Destination:=NewWs.Columns(1) NewWs.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes NewWs.Range(Cells(2, 1).Address & ":" & Cells(1, 1).End(xlDown).Address).Copy Destination:=NewWs.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) NewWs.Columns(1).ClearContents End If Next ws NewWs.Columns(2).RemoveDuplicates Columns:=1, Header:=xlNo Set Cell1 = NewWs.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) Cell1.Offset(1, -1) = "Symbol" Cell1.Offset(1, 0) = "Company" Cell1.Offset(1, 1) = "Director Salutation" Cell1.Offset(1, 2) = "Director First Name" Cell1.Offset(1, 3) = "Director Middle Name" Cell1.Offset(1, 4) = "Director Surname" Cell1.Offset(1, 5) = "Gender" For ws = 1 To Sheets.Count If Left(Sheets(ws).Name, 4) >= StrtD And Left(Sheets(ws).Name, 4) <= EndD Then lrow = Sheets(ws).Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lrow On Error Resume Next If Not IsNull(WorksheetFunction.VLookup(Sheets(ws).Cells(i, 1), NewWs.Range(NewWs.Cells(2, 1).NewWs.Cells(2, 1).End(xlDown)), 1, False)) Then Sheets(ws).Rows(i).Copy Destination:=Rows(NewWs.Cells(Rows.Count, 1).End(xlUp).Row + 1) End If Next i End If Next ws NewWs.Range(Rows(1), Rows(Cells(1, 1).End(xlDown).Row - 1)).Delete NewWs.Range(Columns(1), Columns(7)).Sort Key1:=Range("A1"), Header:=xlYes Application.ScreenUpdating = True End Sub
-
-
-
-
Re: VBA code testing
Re-checking Pike's post
After: Strange. Not sure why it's still getting flagged
Code
Display MoreSub sannuk7() Dim NewWs As Worksheet Dim lrow As Long Dim i As Long Dim ws As Integer Dim StrtD As Integer Dim EndD As Integer Dim Cell1 As Range StrtD = Application.InputBox("Please insert start year", "Start Year", "2000") EndD = Application.InputBox("Please insert end year", "End Year", Year(Now)) Application.ScreenUpdating = False On Error Resume Next Application.DisplayAlerts = False Sheets("Summary").Delete Application.DisplayAlerts = True Set NewWs = Worksheets.Add(After:=Sheets(Sheets.Count)) NewWs.Name = "Summary" For ws = 1 To Sheets.Count If Left(Sheets(ws).Name, 4) >= StrtD And Left(Sheets(ws).Name, 4) <= EndD Then Sheets(ws).Columns(1).Copy Destination:=NewWs.Columns(1) NewWs.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes NewWs.Range(Cells(2, 1).Address & ":" & Cells(1, 1).End(xlDown).Address).Copy Destination:=NewWs.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) NewWs.Columns(1).ClearContents End If Next ws NewWs.Columns(2).RemoveDuplicates Columns:=1, Header:=xlNo Set Cell1 = NewWs.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) Cell1.Offset(1, -1) = "Symbol" Cell1.Offset(1, 0) = "Company" Cell1.Offset(1, 1) = "Director Salutation" Cell1.Offset(1, 2) = "Director First Name" Cell1.Offset(1, 3) = "Director Middle Name" Cell1.Offset(1, 4) = "Director Surname" Cell1.Offset(1, 5) = "Gender" For ws = 1 To Sheets.Count If Left(Sheets(ws).Name, 4) >= StrtD And Left(Sheets(ws).Name, 4) <= EndD Then lrow = Sheets(ws).Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lrow On Error Resume Next If Not IsNull(WorksheetFunction.VLookup(Sheets(ws).Cells(i, 1), NewWs.Range(NewWs.Cells(2, 1).NewWs.Cells(2, 1).End(xlDown)), 1, False)) Then Sheets(ws).Rows(i).Copy Destination:=Rows(NewWs.Cells(Rows.Count, 1).End(xlUp).Row + 1) End If Next i End If Next ws NewWs.Range(Rows(1), Rows(Cells(1, 1).End(xlDown).Row - 1)).Delete NewWs.Range(Columns(1), Columns(7)).Sort Key1:=Range("A1"), Header:=xlYes Application.ScreenUpdating = True End Sub
-
-
Re: VBA code testing
More basic check
Different layout[vb]
NewWs.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes[/code]
Different layoutCode
Display MoreNewWs.Columns(1).Remove With NewWs.Columns(1) .RemoveDuplicates .Remove End With [/vb] [vba] NewWs.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
Different layoutCode
Display MoreNewWs.Columns(1).Remove With NewWs.Columns(1) .RemoveDuplicates .Remove End With [/vba] [vbn]NewWs.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
Different layoutCode
Display MoreNewWs.Columns(1).Remove With NewWs.Columns(1) .RemoveDuplicates .Remove End With [/vbn] [vbs] NewWs.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes
Different layout
[code]
NewWs.Columns(1).RemoveWith NewWs.Columns(1)
.RemoveDuplicates
.Remove
End With
[/vbs] -
-
Re: VBA code testing
cytop does this work?
-
Re: VBA code testing
Nope...
-
Re: VBA code testing
Didn't think so, saw something on a post that made me think otherwise so thought I'd try it. At risk of being lynched
-
-
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!