Need help rewriting code

[stanco]

i have a code which was written by a freelancer on a dummy file. when i tried to copy the code into my original file, i ran into some error. i understand that the code contains a lot of .select and was advised to rewrite the code.

can anyone help me with that?

Sub Macro2()'' Macro2 Macro
'




'
    Range("Table1[[#Headers],[SURVEY 1 DATE]]").Select
    Windows("Book1.xlsx").Activate
    Application.WindowState = xlNormal
    Application.WindowState = xlNormal
    Windows("20190322.xlsm").Activate
    Columns("B:B").Select
    Selection.Copy
    Range("Table1[[#Headers],[COMPANY NAME]]").Select
    Sheets.Add After:=ActiveSheet
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$2:$A$1602").RemoveDuplicates Columns:=1, Header:=xlNo
    Sheets("Sheet2").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Engagement Log").Select
    Range("AE2").Select
    Sheets("Sheet1").Select
End Sub

i have a table with all the companies details, including the different dates that the companies do their surveys. the surveys are done on ad hoc basis, so a company may be doing the X time survey, while some are on their first.

the vba codes above are supposed to extract all the companies who have done at least two surveys on a specific dates. if the company has done survey 2 and 3 within the specified date, then it should appear in the same row.

this is the file that the freelancer worked on with dummy data. i believe it's easier for you to understand once you see the file.

 

[James006]

Hello,

Looks like a macro generated by the macro recorder ...

Are you working with several files ...?

 

[stanco]

Hello,

Looks like a macro generated by the macro recorder ...

Are you working with several files ...?

that is my understanding as well, and it makes the code not dynamic.

there are only two files involved. one was a duplicate file with dummy data where the code was written on (by someone else). and now it wont work when i import the code into my original file.

 

[stanco]

Help pls..

 

[Fluff]

The code you posted does (to all intents and purposes) absolutely nothing.
Are you sure you posted the correct code?

 

[stanco]

The code you posted does (to all intents and purposes) absolutely nothing.
Are you sure you posted the correct code?

there is another module, but another user told me that was ok, and it's only the posted code above that need rewriting. (link here)

Sub dateCheck()    Dim sht, sht2 As Worksheet    Dim xStartDate As Date
    Dim xEndDate As Date
    Dim xDate As Date
    
    Set sht = ThisWorkbook.Worksheets("Engagement Log")
    Set sht2 = ThisWorkbook.Worksheets("Result")
    
    
    a = sht.Cells(Rows.Count, 2).End(xlUp).Row
    b = sht.Cells(1, Columns.Count).End(xlToLeft).Column
    xcol = Replace(ActiveSheet.Cells(1, b).Address(True, False), "$1", "")
    Rng = sht.Range("A1:" & xcol & 1)
     
    
    
    a2 = sht2.Cells(Rows.Count, 2).End(xlUp).Row
    If a2 > 5 Then sht2.Range("A6:A" & a2).EntireRow.Delete
    a2 = sht2.Cells(Rows.Count, 2).End(xlUp).Row
    j = a2
    b2 = sht2.Cells(5, Columns.Count).End(xlToLeft).Column
    xcol2 = Replace(ActiveSheet.Cells(1, b2).Address(True, False), "$1", "")
    Rng2 = sht2.Range("A5:" & xcol2 & 5)
    
    
    
    xSurveyCount = sht2.Range("H1").Value
    xStartDate = sht2.Range("B1").Value
    xEndDate = sht2.Range("B2").Value
    
    Set RowRange = sht.Range("B2:B" & a)
    
    For Each rowvalue In RowRange
        xrow = rowvalue.Row
        
        xCert = sht.Cells(xrow, 1).Value
        xUEN = sht.Cells(xrow, 2).Value
        xCName = sht.Cells(xrow, 3).Value
'        xSProject = sht.Cells(xrow, 4).Value
'        xSector = sht.Cells(xrow, 8).Value
        Z = 0
        For i = 2 To xSurveyCount
            d = Application.WorksheetFunction.Match("SURVEY " & i & " DATE", Rng, 0)
            xDate = sht.Cells(xrow, d).Value
            d2 = Application.WorksheetFunction.Match("SURVEY " & i & " DATE", Rng2, 0)
            If xDate >= xStartDate And xDate <= xEndDate Then
'                d2 = Application.WorksheetFunction.Match("SURVEY " & i & " DATE", Rng2, 0)
                If xCert <> sht2.Cells(j, 1).Value And xUEN <> xUEN2 And xCName <> sht.Cells(j, 3).Value Then
                  z2 = d2
                  Z = Z + 1
                  j = j + 1
                  sht2.Cells(j, 1).Value = sht.Cells(xrow, 1).Value
                  sht2.Cells(j, 2).Value = sht.Cells(xrow, 3).Value
                  sht2.Cells(j, 3).Value = sht.Cells(xrow, 4).Value
                  sht2.Cells(j, 4).Value = sht.Cells(xrow, 8).Value
                  
                  sht2.Cells(j, d2).Value = sht.Cells(xrow, d).Value
                Else
                 z2 = d2
                 Z = Z + 1
                 sht2.Cells(j, d2).Value = sht.Cells(xrow, d).Value
                End If
            End If
        Next
'        If Z >= 2 Then xZdate = sht2.Cells(j, z2).Value
'        If Z >= 2 Then xZdate1 = sht2.Cells(j, z2 - 1).Value
'        If Z >= 2 And xZdate > xZdate1 Then sht2.Cells(j, d2 + 1).Value = sht2.Cells(j, z2).Value - sht2.Cells(j, z2 - 1).Value
        If Z >= 1 Then sht2.Cells(j, d2 + 1).Value = sht2.Cells(j, z2).Value




        xUEN2 = xUEN
    Next
    MsgBox "Task Completed"
End Sub




Sub ClearResult()
    Dim sht2
    Set sht2 = ThisWorkbook.Worksheets("Result")
   
    
    a2 = sht2.Cells(Rows.Count, 2).End(xlUp).Row
    b2 = sht2.Cells(5, Columns.Count).End(xlToLeft).Column
    'Set RowRange = sht2.Range("A6:A" & a2)
    If a2 > 5 Then sht2.Range("A6:A" & a2).EntireRow.Delete
    
End Sub

 

[Fluff]

As I said the code you originally posted does absolutely nothing, so there is no need to tweak it, you can simply delete it.
If the code you've just posted works & does what you need, use it

 

[stanco]

As I said the code you originally posted does absolutely nothing, so there is no need to tweak it, you can simply delete it.
If the code you've just posted works & does what you need, use it

oh mine... i think u are right. but it's late (at where i am) now. i will try it tomorrow morning.

 

[stanco]

As I said the code you originally posted does absolutely nothing, so there is no need to tweak it, you can simply delete it.
If the code you've just posted works & does what you need, use it

ok, you are right. Module 2 code does work by itself. but the results are not what i wanted.

the code is supposed to filter survey 2-6 within the date range that i keyed in and display the results. when i manually filter survey 2, i get 19 counts, but the code only return 13 (this is for Jan 2019). for feb 19, it return 2 counts instead of 15. i didnt check further but this obviously need some working on.

would you be able to assist? or should i start a new thread?