Macro to replace formulas in Sheet

[gtvkeith]

Hi everyone,

I am trying to replace the formulas in a sheet with formulas run from a Macro.
The formulas are supposed to look in all the previous rows of the sheet and find a match to the visitor name.

The formulas are then supposed to paste the corresponding data from the row with the matching name into the current row. This works fine as formulas in a worksheet but that workbook is now pushing 30Mb in size and is very slow to run.

If I can run the formulas as an event via a Macro I hope to speed things up considerably.

The Macro needs to run everytime a visitor name is entered in column C.

Col A = Date
Col B = Time
Col C = Visitor Name
Col D = Contact Number
Col E = Representing
Col F = Person Visiting
Col G = Department Visiting

Any help on this will be appreciated.

Thanks Keith.

This is the code I have been working on, it is located in the Worksheet object;

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
    
    Dim DataSheet As Worksheet
    Dim PreviousRow As Long, CurrentRow As Long, LastRow As Long
    Dim VisitorName As String, Mobile As String, Representing As String, Visiting As String, Company As String
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    CurrentRow = LastRow + 1
    
    VisitorName = Range("C" & CurrentRow).Value
        
    Mobile = Application.WorksheetFunction.VLookup(VisitorName, Range("C" & CurrentRow), Sheets("Sheet1").Range("C2:D" & PreviousRow, 2, False))
    Representing = Application.WorksheetFunction.VLookup(VisitorName, Range("C" & CurrentRow), Sheets("Sheet1").Range("C2:E" & PreviousRow, 3, False))
    Visiting = Application.WorksheetFunction.VLookup(VisitorName, Range("C" & CurrentRow).Sheets("Sheet1").Range("C2:F" & PreviousRow, 4, False))
    Company = Application.WorksheetFunction.VLookup(VisitorName, Range("C" & CurrentRow).Sheets("Sheet1").Range("C2:G" & PreviousRow, 5, False))
    
    If Not Intersect(Target, Range("C2:C36")) Is Nothing Then
        
        'Enters the Date in column 1
        With Target.Offset(0, -2)
            .Value = Date
            '.EntireColumn.AutoFit
        End With
        
        'Enters the time in column 2
        With Target.Offset(0, -1)
            .Value = Time
            '.EntireColumn.AutoFit
        End With
        
        'Enters the Visitor's contact number in column 4
        With Target.Offset(0, 1)
            .Value = "Mobile"
            '.EntireColumn.AutoFit
        End With
        
        'Enters the Visitor's company name in column 5
        With Target.Offset(0, 2)
            .Value = "Rep"
            '.EntireColumn.AutoFit
        End With
        
        'Enters the name of the person being visited in column 6
        With Target.Offset(0, 3)
            .Value = "Vis"
            '.EntireColumn.AutoFit
        End With
        
        'Enters the name of the department being visited in column 7
        With Target.Offset(0, 4)
            .Value = "Comp"
            '.EntireColumn.AutoFit
        End With
        
   End If
    
   Range("A1").Select
    
End Sub

 

[GlennUK]

Your vlookups look completely wrong ... it's looks like you tried twice to make them work and just added more arguments with each attempt. Can you try to get those working first?

 

[gtvkeith]

Yes, this is where I need some help. I am having trouble with the syntax for the Vlookups.

They seem to be worded differently in vb than for in-cell formulas.

I don't even know if I can use ("C" & CurrentRow) as a reference in them in code.

The offsett side of the code to plug in the retrieved data and the date & time is correct and works. I just listed the entire SubRoutine to show how the whole thing should work.

 

[gtvkeith]

I have figured it out , I guess I just needed some sleep and a good coffee in the morning to get a clear head.

For anyone who may check this down the track, I am supplying the completed working code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
    
    Dim DataSheet As Worksheet
    Dim PreviousRow As Long, CurrentRow As Long, LastRow As Long
    Dim VisitorName As String, Mobile As String, Representing As String, Visiting As String, Company As String
    
    LastRow = Cells(Rows.Count, "C").End(xlUp).Row
    PreviousRow = LastRow - 1
    
    VisitorName = Range("C" & LastRow).Value
        
    Mobile = Application.WorksheetFunction.VLookup(VisitorName, Sheets("Sheet1").Range("C2:D" & PreviousRow), 2, False)
    Representing = Application.WorksheetFunction.VLookup(VisitorName, Sheets("Sheet1").Range("C2:E" & PreviousRow), 3, False)
    Visiting = Application.WorksheetFunction.VLookup(VisitorName, Sheets("Sheet1").Range("C2:F" & PreviousRow), 4, False)
    Company = Application.WorksheetFunction.VLookup(VisitorName, Sheets("Sheet1").Range("C2:G" & PreviousRow), 5, False)
    
    If Not Intersect(Target, Range("C2:C36")) Is Nothing Then
        
        'Enters the Date in column 1
        With Target.Offset(0, -2)
            .Value = Date
        End With
        
        'Enters the time in column 2
        With Target.Offset(0, -1)
            .Value = Time
        End With
        
        'Enters the Visitor's contact number in column 4
        With Target.Offset(0, 1)
            .Value = Mobile
        End With
        
        'Enters the Visitor's company name in column 5
        With Target.Offset(0, 2)
            .Value = Representing
        End With
        
        'Enters the name of the person being visited in column 6
        With Target.Offset(0, 3)
            .Value = Visiting
        End With
        
        'Enters the name of the department being visited in column 7
        With Target.Offset(0, 4)
            .Value = Company
        End With
        
    End If
    
   Range("A1").Select
    
End Sub

Thanks for listening GlennUK.

Take it easy.

 

[GlennUK]

I'm glad that you got it working