I have a row such as the following:
Destination: Part:
04586 06509269AA
I want to look up this data in another sheet that has multiple rows of the same data with extra information
Destination: Part: Package:
04586 06509269AA 656665
04586 06509269AA 213226
and return the full data to a new sheet.
I tried doing an index, match, using a key for the data set but it crashes excel due to how much rows of data I actually pull in my query, and also I would need to find a way to increment rows in the new sheet for how many rows of data there actually is.
Any ideas of what I can try in VBA to create this report?
If I am understanding you are trying to get all the "Package values" based on "Part" and "Parameter". I would run a while loop with a for loop inside that iterates at a match and stores in an array that gets bigger using reDim Preserve.
example input with output pasted onto G column
Sub example()
Dim rower, destination, packageCount As Integer
Dim Package() As Variant
Dim part As String
destination = 4586
part = "06509269AA"
rower = 0
packageCount = 0
Sheets("Sheet1").Activate
Range("B3").Activate
Do While ActiveCell.Offset(rower) <> ""
If ActiveCell.Offset(rower) = destination And ActiveCell.Offset(rower, 1) = part Then
packageCount = packageCount + 1
ReDim Preserve Package(packageCount + 1)
Package(packageCount) = ActiveCell.Offset(rower, 2)
End If
rower = rower + 1
Loop
Range("g2").Activate
For i = 0 To UBound(Package)
ActiveCell.Offset(i) = Package(i)
Next i
End Sub
Related
This is a sample of K4 L4
[![enter image description here][2]][2] This is a sample of K63
So again I want to arrange each worksheet in the workbook based on the values in K4, L4 and than K63
Hello I'm looking for a code that will sort the worksheets in the workbook based on multiple cell values. First I will like to sort all worksheets in the workbook based on K4 (text Ascending Order) than by L4 (text Ascending Order) and finally by cell k63 (value greatest to least). I'm struggling with the logic piece on how to make it vba go in sequence. Any insight will be greatly appreciated.
I hid rows and delete sensitive data. But from the screen shot you can basically get the jist of how I would like the worksheets arranged
The following code shows how you could achieve this:
Create an array of objects that hold the information for every sheet, including the sheet name itself
Sort the array according to your needs. I have used a simple bubble sort as it is fast enough for 100 records - but if you want, feel free to look for more efficient sort algorithms, plenty around here on SO and elsewhere. The key of sorting is that you have a custom compare method that returns -1 if object 1 is "smaller" (needs to be sorted to the left) and 1 if it is "larger" - very similar to the strComp-method in VBA.
After sorting, use the sheet names of the sorted array to rearrange the sheets.
Create a class module and name it clsSheetData that holds the information needed for sorting.
Public sheetname As String
Public gmo As String
Public ovp As String
Public percent As Double
Create a regular module with the code (I assume you want to sort ThisWorkbook, else pass the workbook as parameter)
Sub SortSheets()
' Define the array
ReDim arr(1 To ThisWorkbook.Sheets.Count) As clsSheetData
' - - Step 1: Build array with data
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Set arr(ws.Index) = New clsSheetData
arr(ws.Index).sheetname = ws.Name
arr(ws.Index).gmo = ws.Range("K4")
arr(ws.Index).ovp = ws.Range("L4")
arr(ws.Index).percent = ws.Range("K63")
Next
' - - Step 2: Sort Array (Bubblesort)
Dim i As Long, j As Long
For i = 1 To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If sheetCompare(arr(i), arr(j)) > 0 Then
Dim Temp As clsSheetData
Set Temp = arr(j)
Set arr(j) = arr(i)
Set arr(i) = Temp
End If
Next j
Next i
' - - Step3: Rearrange sheets
For i = 1 To UBound(arr)
With ThisWorkbook
.Sheets(arr(i).sheetname).Move before:=.Sheets(i)
End With
Next
End Sub
Function sheetCompare(o1 As clsSheetData, o2 As clsSheetData) As Integer
' Compare the data of 2 sheets.
If o1.gmo <> o2.gmo Then ' If gmo is different, use that as criteria
sheetCompare = StrComp(o1.gmo, o2.gmo, vbTextCompare)
ElseIf o1.ovp <> o2.ovp Then ' Else If ovp is different, use that as criteria
sheetCompare = StrComp(o1.ovp, o2.ovp, vbTextCompare)
Else ' Else, compare percentage
sheetCompare = IIf(o1.percent > o2.percent, -1, 1)
End If
End Function
I would briefly like to start off with I have never touched VBA let alone excel macros until a couple days ago.
I need to transfer and convert data of 1000 rows (4 columns) from one sheet (Sheet 1) to another (Sheet 2).
A quick description of what I'm given, each row is an object, I have 4 columns.
The first one (column) is the Object ID, the second one is the Object name, the third one explain the what of the object and the final column explains the how. This is a very simplified version as explaining the entire project would be complicated.
On the second sheet, I have 6000 rows all with the object's IDs and Names however the What and How are missing.
My goal is to take the what and how of an object from this sheet, convert the wording to a form in which the second sheet accepts and make sure it gets added to the proper ID.
I have tried multiple code samples I have found online to try and select and organize into tables (arrays) the information from the first sheet, I failed miserably.
Converting the What and How
The second sheet has a very strict format in which everything can be written. In my mind (Lua is my main language), I would have a dictionary or table with all possible ways of the How/What could be written on the first sheet and checking each one to see if they match then change it to the corresponding sheet 2 format. Let me show you. (This is the what. There'd be another table for the how which I'll show below)
local MType = {
["Industrial"] = {"MILPRO : Industrial","Industrial"};
["Public Saftey"] = {"MILPRO : Public Saftey", "Public Saftey"};
["Military"] = {"MILPRO : Military","Military"};
["Paddling"] = {"Recreation : Paddling","Paddling"};
["Sporting Goods"] = {"Recreation : Sporting Goods","Sporting Goods"};
["Outdoor"] = {"Recreation : Outdoor", "Outdoor"};
["Hook & Bullet"] = {"Recreation : Hook & Bullet", "Hook & Bullet"};
["Marine"] = {"Recreation : Marine","Marine","Marina / Lodge"};
["Sailing"] = {"Recreation : Sailing","Sailing"};
["Unknown"] = {"UNKNOWN"}
}
local CType = {
["Multi-Door"] = {"Multi-Door","Multi-door"};
["Dealer & Distributor"] = {"Distributor","Dealer & Distributor"};
["Independant Specialty"] = {"Independant Specialty","Specialty"};
["OEM"] = {"OEM","OEM - VAR"};
["Internal"] = {"Internal","Sales Agency","Repairs Facility"};
["Rental"] = {"Rental / Outfitter", "Rental"};
["End User"] = {"End User"};
["Institution"] = {"Institution","Government Direct"};
["Unknown"] = {"UNKNOWN"}
}
The first position in each table (table = the curly brackets) is the format in which the second sheet accepts. The rest in the tables is how they might be written in the first sheet. (This is how I imagine this would go down. Idk the functions and limits of VBA)
Matching the Information to the Proper IDs
Every object has an ID 6 characters long ranging from 000100 to 999999. When taking information from the first sheet, I need to make sure it gets placed back in the row with the right ID in the second sheet (Note there's 1000 rows on the first sheet and 6000 on the second sheet).
Final notes: The IDs are stored as text and not numbers (If they need to change lmk). Both sheet's information are within tables. I'll probably be using this method for other similar sheet 1s. Any conversions (for the what and how) that fail should be marked down as Unknown.
A Visual Representation of the 2 Sheets
Sheet 1 Format
Sheet 2 format
We can create a 2 dimensional array to hold all the pairs of one dictionary, then check against each element using a For..Next loop.
Sub transcribe()
On Error GoTo Handler
Application.ScreenUpdating = False
Dim WS1 As Worksheet, WS2 As Worksheet
Dim ID1 As Range, ID2 As Range
'This is assuming youre working in Sheets 1 and 2
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
'This is assuming your tables are in these locations
Set ID1 = WS1.Range(WS1.Cells(1, 1), WS1.Cells(10, 1))
Set ID2 = WS2.Range(WS2.Cells(1, 1), WS2.Cells(20, 1))
Dim cellx As Range
Dim rowID1 As Integer
Dim FieldA As String, FieldB As String
Dim IDfound As Boolean
IDfound = True
Dim arrayA(1 To 10, 1) As String
arrayA(1, 0) = "MILPRO : Industrial"
arrayA(1, 1) = "Industrial"
arrayA(2, 0) = "MILPRO : Public Saftey"
arrayA(2, 1) = "Public Saftey"
'... etc. You have to complete this array with all the pairs of your dictionary of Field A
'array(X, 1) holds what you expect to find in table 1, and array(X, 0) holds what you want to write down in table 2.
Dim arrayB(1 To 9, 1) As String
arrayB(1, 0) = "Multi-Door"
arrayB(1, 1) = "Multi-Door"
arrayB(2, 0) = "Distribuitor"
arrayB(2, 1) = "Dealer & Distribuitor"
'... etc. You have to complete this array with all the pairs of your dictionary of Field B
'array(X, 1) holds what you expect to find in table 1, and array(X, 0) holds what you want to write down in table 2.
'Now we sweep each cell in Table 2
For Each cellx In ID2.Cells
'And we search its ID for a match in Table 1.
rowID1 = Application.Match(cellx.Value, ID1, 0)
If IDfound = True Then
'We then write down the values of Field A and B in the found row
FieldA = ID1.Resize(1).Offset(rowID1 - 1, 2).Value
FieldB = ID1.Resize(1).Offset(rowID1 - 1, 3).Value
'And we call a function (see below) to correct their values
cellx.Offset(0, 2).Value = corrected(FieldA, arrayA, 10)
cellx.Offset(0, 3).Value = corrected(FieldB, arrayB, 9)
Else
cellx.Offset(0, 2).Value = "ID not found"
cellx.Offset(0, 3).Value = "ID not found"
IDfound = True
End If
Next
Application.ScreenUpdating = True
Exit Sub
Handler:
IDfound = False
Resume Next
End Sub
Function corrected(Field As String, arrayX As Variant, UB As Integer) As String
'This is the dictionary-like function
Dim found As Boolean
'We sweep each element in the dictionary array until we find a match
For i = 1 To UB
If Field = arrayX(i, 1) Then
corrected = arrayX(i, 0)
found = True
Exit Function
Exit For
End If
Next
'If no match was found, we will write that down in the result
If found = False Then
corrected = Field & " - Not found in dictionary"
Exit Function
End If
'This code should never be reached, its just for foolproofing
corrected = "Error"
End Function
I have an excel table called AnimeList, where I have listed all the anime I have finished watching along with their info. The table has the following headers:
Name, Main Genre, Genre2, Genre3, Rating, Seasons, Episodes, Mins/Episode, Status.
I have written some VBA code that can count the distinct genres from the 3 columns as well as the number of them present.
Function CountAndSortGenre()
Dim size As Integer: size = Range("AnimeList[Main Genre]").Rows.Count
ReDim genreExtract((size * 3) - 1) As String
Dim i As Integer: i = 0
Dim cell As Range
For Each cell In Range("AnimeList[Main Genre]")
genreExtract(i) = cell.Value
i = i + 1
Next
For Each cell In Range("AnimeList[Genre - 2]")
genreExtract(i) = cell.Value
i = i + 1
Next
For Each cell In Range("AnimeList[Genre - 3]")
genreExtract(i) = cell.Value
i = i + 1
Next
Dim distinctGenres As New Dictionary
Dim genre As Variant
For Each genre In genreExtract
If distinctGenres.exists(genre) Then
distinctGenres(genre) = distinctGenres(genre) + 1
Else
distinctGenres.Add genre, 1
End If
Next
size = distinctGenres.Count
Erase genreExtract
ReDim sortedGenres(size - 1, 1) As Variant
For i = 0 To distinctGenres.Count - 1
sortedGenres(i, 0) = distinctGenres.Keys(i)
sortedGenres(i, 1) = distinctGenres.Items(i)
Next i
distinctGenres.RemoveAll
QuickSort sortedGenres, 0, size - 1 'This is done in a separate function
End Function
At the end I have what I need, i.e. the sorted genre counts in my sortedGenre array.
But I need to output it to the excel sheet now which is proving to be rather difficult task.
I tried calling the function after adding return type "As Variant" in the declaration and adding the statement CountAndSortGenre = sortedGenres at the end like so:
=CountAndSortGenre()
but the array which is returned is not spilled across multiple cells. Instead only the first element of the array is displayed on the cell where I input the formula.
I tried using Ctrl+Shift+Enter which changed the formula to:
{=CountAndSortGenre()}
but that did not change the output. It was still the first element of the array
I tried putting it in the index formula like so:
INDEX(CountAndSortGenre(), 1, 2)
trying to at least get something other than the first value of the array but that still kept returning the first value only.
Afterwards I tried using a manual approach to push the values into the cells by removing the As Variant return type and the return value in the end and adding the following code:
For i = 0 To size - 1
Application.ActiveCell.Offset(i + 1, 1) = sortedGenres(i, 0)
Application.ActiveCell.Offset(i + 1, 2) = sortedGenres(i, 1)
Next i
This approach worked when I ran the code but when I tried using the function like:
= CountAndSortGenre()
Excel gave me circular reference warning and thus it did not work.
The reason I dont want to use the macro and want to use it as a function is that I want these values to get updated as I update my source table. I am not sure that using a function will be dynamic, but it is the best bet. But right now I just want this function to start working.
I used an Array List because I'm too lazy to go look for my QuickSort routine; and I only created a single dimension output for horizontal output.
I used the range as an argument for the function so it would update dynamically when a cell in the called range is changed.
If your range may change in size, I'd suggest using either a dynamic named range, or using a Table with structured references, either of which can auto adjust the size.
If you require a vertical output, you can either Transpose before setting the output of the function; or loop into a 2D array.
Option Explicit
Option Compare Text
Function CountAndSortGenre(rg As Range) As Variant()
Dim v As Variant, w As Variant
Dim distinctGenres As Object
v = rg
Set distinctGenres = CreateObject("System.Collections.ArrayList")
With distinctGenres
For Each w In v
If w <> "" Then
If Not .contains(w) Then .Add w
End If
Next w
.Sort
CountAndSortGenre = .toarray
End With
End Function
I have an excel table, with one of the columns is named ID.
I am trying to do a search of that column to find what row contains a certain value. I have tried many different commands, (all of which check our with the editor's syntax checking), but I cannot figure out how to get it to work.
My line of code that I am trying to make work is toward the bottom of the program and is foundrow = summObj.ListColumns("ID")...
Here is my code so far:
Private Sub Reload_Click()
'Routine to move data to table from Molding Table
'Check to not overwrite current records but add new ones.
Dim summObj As ListObject
Dim moldObj As ListObject
Dim I, X As Integer
Dim summObjRows As Integer
Dim moldObjRows As Integer
Dim key As String
Dim foundrow As Integer
' Get the table reference
Set summObj = Worksheets("Summary").ListObjects("SummaryTable")
Set moldObj = Worksheets("MoldingData").ListObjects("MoldingTable")
summObjRows = summObj.ListRows.Count
moldObjRows = moldObj.ListRows.Count
'Check if table is empty
If summObjRows = 0 Then
'Set up the first row
summObj.ListRows.Add
summObj.ListColumns("ID").DataBodyRange(1) = "New"
End If
X = 1
For I = 1 To moldObj.ListRows.Count
key = moldObj.DataBodyRange(I, moldObj.ListColumns("ID").DataBodyRange.Column) & "," & moldObj.DataBodyRange(I, moldObj.ListColumns("6-Way").DataBodyRange.Column)
If moldObj.DataBodyRange(I, moldObj.ListColumns("Volume").DataBodyRange.Column) <> "" Then
If Not (key = summObj.ListColumns("ID").DataBodyRange(X)) Then
'Insert row into Summary Table unless this is the first row in a blank table.
If Not summObj.ListColumns("ID").DataBodyRange(X) = "New" Then
summObj.ListRows.Add (X)
End If
summObj.ListColumns("ID").DataBodyRange(X) = key
summObj.ListColumns("Volume").DataBodyRange(X) = moldObj.ListColumns("Volume").DataBodyRange(I)
summObj.ListColumns("Item Name").DataBodyRange(X) = moldObj.ListColumns("Item Name").DataBodyRange(I)
summObj.ListColumns("Data1").DataBodyRange(X) = moldObj.ListColumns("Data1").DataBodyRange(I)
summObj.ListColumns("Data2").DataBodyRange(X) = moldObj.ListColumns("Data2").DataBodyRange(I)
Else
summObj.ListColumns("Volume").DataBodyRange(X) = moldObj.ListColumns("Volume").DataBodyRange(I)
summObj.ListColumns("Data2").DataBodyRange(X) = moldObj.ListColumns("Data2").DataBodyRange(I)
End If
X = X + 1
Else
'Check it to see if it is in Summary, and if so remove it
foundrow = summObj.ListColumns("ID").DataBodyRange.Find(key).Row
End If
Next I
End Sub
Thanks for helping me to solve this one.
Rich
I made a small change to the line in question.
I removed the (x) from the line.
Now what happens is that if the string is found in the column, then the row number is put in foundrow. If the string is not in the column, then i get the runtime error '91'
Any additional thoughts?
Rich
I need to copy date and time, code and names from a big data sheet, which contains multiple columns. Row counts may differ.
The sequence of actions should be:
Copy the consecutive Range from A3 which is the first active cell through to the data at column AZ - This is a manual selection.
Using the VBA linked Command button start the process of copying data in next sheet:
for example
sheet1.column B = sheet2.column A
sheet2.column B= ""
'empty and data copy is not needed, please just generate the empty row
sheet1.column Y = sheet2.column C
After the copying process is over, clear all data from sheet1
My core problem is the data count for above rows differs every time. I can't find a correct sequence of commands to get these columns in the order I need from sheet1. To add to that, the formatting breaks and the time values are 'stringified', so it can't be reused.
The generated data needs to be exported to another workbook and the copying process is critically important as I do it repeatedly. Locating and copying each column manually every time.
The solution to your problem is of the form f(x) = y where x is the column no. of the source sheet and y is the column number of that very same column on the destination sheet.
f(x) is a simple mapping between a Source column and transformed into a destination column no.
As you still need to define the problem better by including sample data, I'll simply brief you on The 3 steps to resolve your problem.
I hope you know your VBA well enough to encode the steps into the specific VBA code you need to solve this permanently.
Create a sheet as a "ControlPanel" that maps the columns you need.
Assuming your sheets are named appropriately as per the code below.
Kindly do apply your VBA skills and discretion to customize the code below as per your needs.
Public Sub Add_Msng_And_Check_Prev_EmpData()
'' Objective : Check missing employees from the incoming data placed in the Destination_Sheet sheet which is the client's format.
'' The _Source_Sheet sheet is our destination where processed data sits,
'' columns from Destination_Sheet are mapped to specific columns of the _Source_Sheet sheet.
'' Copy the missing emp codes to these mapped columns.
'' Support : myfullnamewithoutspaces#gmail.com
'' Status : Production 14-Dec-2016 10.32 PM
'' Version : 1.0
'' To Do : 10 is the column number on Source_Sheet where the emp code resides
'' Convert this magic number to a generic solution
Dim Src_Sheet, Destination_Sheet As Worksheet
Dim Dest_Sheet_Column_Mapping, Src_Sheet_Column_Location As Range
Set Src_Sheet = Sheets("Source_Sheet")
Set Destination_Sheet = Sheets("Destination_Sheet")
Set Dest_Sheet_Column_Mapping = Sheets("ControlPanel").Range("A2:A60")
Set Src_Sheet_Column_Location = Sheets("ControlPanel").Range("D2:D60")
Dim myMap() As Integer
Dim myRow As Variant
ReDim myMap(Dest_Sheet_Column_Mapping.Count + 1)
'' Map the source_columns to the destination_columns
For Each myRow In Src_Sheet_Column_Location
'' Index corresponds to Source_Sheet column
'' Value at Index to Destination_Sheet
'' for eg: Destination_Sheet.column = myMap(Src_Sheet.column)
myMap(myRow) = Dest_Sheet_Column_Mapping.Cells(myRow, 1).Value
Next myRow
Dim Primary_Key_Not_Null As Collection
Set Primary_Key_Not_Null = New Collection
Dim Master, Src_Sheet_Range, Src_Range As Range
Dim MissingEmployeeCode, LookupValue, tempVar, LookupResult As Variant
Dim LastRow, i, Src_Range_Rows_Count, Src_Sheet_Range_Rows_Count As Integer
'' This is the source of all new entries we need to search for.
Set Src_Sheet_Range = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Destination_Sheet.Cells(1048576, myMap(10)).End(xlUp).Row, myMap(10)))
Src_Sheet_Range_Rows_Count = Src_Sheet_Range.Rows.Count
'' This is the database of all previous existing entries we need to search against.
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(Src_Sheet.Cells(1048576, 10).End(xlUp).Row, 10))
Src_Range_Rows_Count = Src_Range.Rows.Count
For i = 3 To Src_Sheet_Range_Rows_Count
'' Skip the blank rows and header at rows 0 to 2
On Error Resume Next
LookupValue = Destination_Sheet.Cells(i, myMap(10)).Value
LookupResult = Application.Match(LookupValue, Src_Range, 0)
If (IsError(LookupResult)) Then
'' To Do : Check for Duplicates within the previously added values
'' LookupValue becomes your missing empcode and i is the row number it's located at
'' The row number i becomes critical when you want to copy the same record that you have just found missing.
Primary_Key_Not_Null.Add i '' LookupValue
'' LookupValue is the actual missing empcode, however we need the row number for the copy operation later
End If
Next i
LastRow = Src_Sheet.Cells(1048576, 10).End(xlUp).Offset(1, 0).Row
Dim FirstRow, LastColumn, j, Src_Range_Columns_Count As Integer
FirstRow = LastRow
''--Phase 3--------------------------------------------------------------------------------------------------
'' Objective : Get and paste data for each missing empcode
With Src_Range
LastColumn = .Cells(1, 1).End(xlToRight).Column
LastRow = Primary_Key_Not_Null.Count + FirstRow
Set Src_Range = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
Src_Range_Columns_Count = Src_Range.Columns.Count
For i = FirstRow To LastRow ''FirstRow + 3 '' Commented for Debugging
For j = 1 To Src_Range_Columns_Count '' 59
'' The simple logic is Row Numbers and Column numbers obtained from all the above operations
'' define the cells in the Src_Sheet sheet that we need this data pasted ito.
'' For details please see the code below.
Src_Sheet.Cells(i, j).Value = Destination_Sheet.Cells(Primary_Key_Not_Null(i - FirstRow + 1), myMap(j)).Value
Next j
Next i
End With
''--Phase 4--------------------------------------------------------------------------------------------------
'' Objective : For the previous range in Source_Sheet, check each cell in each column against the mapped columns in the Destination_Sheet.
'' When you find a discrepancy: style it Bad, for the matches: style it Good,
'' for the not found : Style it neutral.
LastRow = FirstRow
FirstRow = 2
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(2, 1), Src_Sheet.Cells(LastRow, LastColumn))
Src_Range.Style = "Normal"
Dim FoundRow, FoundColumn As Integer
FoundRow = 0
FoundColumn = 10
Dim LookupRange, LookupDatabase As Range
Set LookupRange = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(LastRow, 10))
Set LookupDatabase = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Src_Sheet_Range_Rows_Count, myMap(10)))
Dim FoundRows As Collection
Set FoundRows = New Collection
'' Locate the row of each employee code on Emp Master, push it into a collection and let the emp code be it's key
Dim LookupRange_Row_Count As Integer
LookupRange_Row_Count = LookupRange.Rows.Count
For i = 2 To LookupRange_Row_Count
On Error Resume Next
FoundRow = Application.Match(LookupRange.Cells(i, 1).Value, LookupDatabase, 0)
If (Not IsError(FoundRow)) Then
'' myRow contains EmpCode which is the key, FoundRow = Where I Found it, becomes the value.
FoundRows.Add FoundRow, CStr(LookupRange.Cells(i, 1).Value)
End If
Next i
Dim Src_Sheet_Value, EmpMstrValue, myEmpCodeString As String
For i = FirstRow To LastRow '' 2 to 1029
For j = 1 To Src_Range_Columns_Count '' 59
'' Handle 4 cases.
'' 1. Src_Sheet Cell Value Found and matches = Good
'' 2. Src_Sheet Cell Value Found and does not match = Bad
'' 3. Src_Sheet Cell Value Not Found or not in Scope and hence does not match = Neutral
'' 4. Src_Sheet Cell Value is a duplicate of a value which is already checked earlier. = ??
Src_Sheet_Value = Src_Sheet.Cells(i, j).Value
myEmpCodeString = CStr(LookupRange.Cells(i, 1).Value)
myRow = CInt(FoundRows(myEmpCodeString))
EmpMstrValue = Destination_Sheet.Cells(myRow, myMap(j)).Value
'' Implements 1. Src_Sheet Cell Value Found and matches = Good
If Src_Sheet_Value = EmpMstrValue Then
Src_Sheet.Cells(i, j).Style = "Good"
Else
Src_Sheet.Cells(i, j).Style = "Bad"
End If
Next j
Next i
End Sub
I found myself in the same situation as yourself sometime back. Although the code is conceptually simple, it requires you to thoroughly define your problem in the Source, Destination, Transformation pattern.
Do Feel free to mail me at myfullnamewithoutspaces#gmail.com. I'll assist any way I can.