Efficient way to use index match or alternative method to insert values dynamically into worksheet

[ShaunH]

Hi everyone. I am stuck.
I need to fill values into columns using VBA in much the same way as INDEX and MATCH does, but using VBA. I have everything turned off already.

My data uses VBA to copy select columns from one sheet to a new sheet "Analyse" in Columns A to G. That works perfectly. The rows are dynamic as the source data changes occasionally.

Here is the problem: I need to lookup from a table on one sheet "GroupData" Column 1 and return column 2 and 3 in H and I,

using entries in column D as my MATCH.​

Then there is another lookup in a another sheet and table "SCPvalue", that looks at column 1 and returns column 2,

using entries in "Analyse" column E as my MATCH.​

All columns have headers as they are tables

It works fine if the formula is in the cell, but that is easily broken and has to remain even if the sheet has no values as that is something that does happen, which has it's own problems.
I have other code that also works by using VBA, but it is slow and still incomplete.

I clear the sheet from row 2 down before filling the new data. Data can be anything from 1 to 2000 rows of data.
The lookup is applied after the data is filled. "GroupData" is a Customer, Holding Company and Group list of 7000 rows, which can grow beyond 7000.
The other lookup table is only about 10 rows and two columns, dimSCP and SCPvalue, unlikely to change, but if it does, I need to make provision for it.

This is the slow incomplete VBA. It takes about 10 seconds to run through the customer database. The othe part is incomplete.

Sub FillValues()
Dim strThisFile As String
strThisFile = "TestFile.xlsm"

Dim strSheetA As String
strSheetA = "Analyse"
Dim strSheetG As String
strSheetG = "GroupData"
Dim strSheetS As String
strSheetS = "SCPvalues"

Dim intCounterA_Y As Integer
intCounterA_Y = 2
Dim intCounterG_Y As Integer
intCounterG_Y = 2
Dim intCounterS_Y As Integer
intCounterS_Y = 2

While Workbooks(strThisFile).Sheets(strSheetA).Cells(intCounterA_Y, 1).Value <> "" ' Loop through Anlayse
intCounterG_Y = 2
While Workbooks(strThisFile).Sheets(strSheetG).Cells(intCounterG_Y, 1).Value <> "" ' Loop through GroupData
If Workbooks(strThisFile).Sheets(strSheetA).Cells(intCounterA_Y, 4).Value = Workbooks(strThisFile).Sheets(strSheetG).Cells(intCounterG_Y, 1).Value Then
Workbooks(strThisFile).Sheets(strSheetA).Cells(intCounterA_Y, 8).Value = Workbooks(strThisFile).Sheets(strSheetG).Cells(intCounterG_Y, 3).Value
Workbooks(strThisFile).Sheets(strSheetA).Cells(intCounterA_Y, 9).Value = Workbooks(strThisFile).Sheets(strSheetG).Cells(intCounterG_Y, 2).Value
End If
intCounterG_Y = intCounterG_Y + 1
Wend




intCounterA_Y = intCounterA_Y + 1
    Wend

End Sub

The code only runs once after the data has been copied to "Analyse" sheet. It does not need to watch for changes to this sheet.
I have seen some rather shortened versions of VBA, that claim to be much faster, I cannot say. I'm still learning though.

Please help to either rewrite in a more efficient way, or point me in the right direction?
Also I would appreciate an explanation of the steps to help me learn if possible.

Thank you in advance.

 

[ShaunH]

Thank you, it works on my PC as it should however still an issue on others PC's which I hope I resolved.
=INDEX(CustGroup[dimGroup], MATCH([@[Customer Name]], CustGroup[dimCust],0))
=INDEX(CustGroup[dimHold], MATCH([@[Customer Name]], CustGroup[dimCust],0))
=INDEX(SCPvalue[dimSCPvalue], MATCH([@SLA], SCPvalue[dimSCP], 0))

They weren't geting vaues.

Changed to
=INDEX(CustGroup[dimGroup], MATCH(([Customer Name]), CustGroup[dimCust],0))

=INDEX(CustGroup[dimHold], MATCH(([Customer Name]), CustGroup[dimCust],0))

=IFNA(INDEX(SCPvalue[dimSCPvalue], MATCH([@SLA], SCPvalue[dimSCP], 0)),"8am-5pm Weekdays.")



Also had to move the PivotRefresh to after calculations. Doh!



Thanks I'll try the protect/unprotect. Excellent work. The people sometimes use the filters though.

 

[ShaunH]

I amended the following and added. Everything seems to workinging as needed.

Sub ClearAnalyseTable()
    
    Dim tbl As ListObject
    
    Set tbl = Sheets("Analyse").ListObjects("AnalyseTable")
    CondomOff
    TurnOffStuff
    If Not tbl.DataBodyRange Is Nothing Then
tbl.DataBodyRange.Delete
tbl.AutoFilter.ShowAllData
End If

CondomOn
TurnOnStuff
End Sub

Also added protection

Sub CondomOn() ' Protecion turned on
Sheets("Analyse").Protect Password:="*******", _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

'Allowing selection of locked or unlocked cells
    Sheets("Analyse").EnableSelection = xlNoRestrictions
End Sub

Sub CondomOff() ' Protection turned off
Sheets("Analyse").Unprotect Password:="*******"
End Sub

 

[ShaunH]

Jumping back to the Analyse code, I want to check if the Temp sheet is empty before running the code.
The way I've written it, it does the Analyse and exits if an error occurs.
I should probably include a first If before and check if Temp is empty, if so, MsgBox, else run the code, instead of using the error handler that doesn't work at the moment.

 

[ShaunH]

Jumping back to the Analyse code, I want to check if the Temp sheet is empty before running the code.
The way I've written it, it does the Analyse and is supposed to exit to the error handler if an error occurs.
However, doing it the other way and changing to an If statement before and check if Temp is empty, if so, MsgBox, else run the code, instead of using the error handler that doesn't work at the moment anyway.
I've run various scenarious with incorrect data in the clipboard and all is well there. Just not when there is no data.

 

[ShaunH]

Doh!
I figured it out. Also removed many duplicate running of code that I was doing.
Seems to be OK now. I thank you for all the help.

 

[FatBoyClam]

Thank you, it works on my PC as it should however still an issue on others PC's which I hope I resolved.
=INDEX(CustGroup[dimGroup], MATCH([@[Customer Name]], CustGroup[dimCust],0))
=INDEX(CustGroup[dimHold], MATCH([@[Customer Name]], CustGroup[dimCust],0))
=INDEX(SCPvalue[dimSCPvalue], MATCH([@SLA], SCPvalue[dimSCP], 0))

They weren't geting vaues.

Changed to
=INDEX(CustGroup[dimGroup], MATCH(([Customer Name]), CustGroup[dimCust],0))

=INDEX(CustGroup[dimHold], MATCH(([Customer Name]), CustGroup[dimCust],0))

=IFNA(INDEX(SCPvalue[dimSCPvalue], MATCH([@SLA], SCPvalue[dimSCP], 0)),"8am-5pm Weekdays.")

Hmmm, the [@[Column Name]] reference style is the notation for "Value from [Column Name] on this row". Removing the @ technically should make the reference to the whole column although I also observe in a quick test, that the two both get the same result - my concern is this not how it is supposed to work, according to MS.

Either way - the @ notation should work - are your other users running Excel 2007? Apparently the table referencing notation was different in that version.

Seems odd that it appears to work in one (SCPValue) and not the other (CustGroup).

Just be mindful this is not how it's documented to work.

Seems to be OK now. I thank you for all the help.

No problem, glad to be of assistance

 

[ShaunH]

Thanks. I only see now what you mean. What I changed was the [ for a (, but as you indicate the @ dropped off too. Hmm I'll have to get users to test.

=INDEX(CustGroup[dimGroup], MATCH([@[Customer Name]], CustGroup[dimCust],0))
=INDEX(CustGroup[dimHold], MATCH([@[Customer Name]], CustGroup[dimCust],0))

All should be on 365 now or 2016 at worst. The Company is quite good at regular updates. Just don't see XLOOKUP yet.

I am almost on final release, but looks like I will hold off a bit.​

​

 

[ShaunH]

I added the @ back and it changed to =INDEX(CustGroup[dimGroup], MATCH(([@[Customer Name]]), CustGroup[dimCust],0))
I'm going to ask someone to test for me, works fine on my machine though.

 

[MARK858]

All should be on 365 now or 2016 at worst. The Company is quite good at regular updates. Just don't see XLOOKUP yet.

Just for info... XLOOKUP/XINDEX is only available on 365 if they are on the monthly update channel or the Insider program, it won't be on the Bi-Annual channel until the July update. It won't appear on 2016 at all.

 

[ShaunH]

Thanks MS Office 365 Pro Plus Subs