MS Excel VBA script - function

I haven't tried coding except in javascript in the past, however i'm pretty new.
I'm trying to create a macro for excel that will compare a the values in sheet1 in column B individually to corresponding column B in sheet2 to find a match. If no match is found the entire row is added to the bottom of the spreadsheet. any help on where to start would be appreciated.
I have 6 columns in the list

The key to what you are attempting is in understanding the nested Loops.
Begin by looping through Sheet 1
Set a temp Value for each row
Begin loop of Sheet 2, each row comparing the temp Value.
Use a boolean variable to track if there was a match or not
At the end of the loop of Sheet 2, If there was no match
Copy the row, by looping through the columns
Continue looping through Sheet 1
Code:
Sub CopyNoMatch()
Dim lastSourceRow As Long
Dim source As String, target As String
Dim tempVal As String
Dim tRow As Long, lRow As Long, lCol As Long, nRow As Long
Dim match As Boolean
source = "Sheet1"
target = "Sheet2"
lastSourceRow = Sheets(source).Range("A" & Rows.count).End(xlUp).row
For lRow = 2 To lastSourceRow 'Loop through Rows on Sheet1
match = False 'Reset boolean test for each new row
tempVal = Sheets(source).Cells(lRow, "B").Text 'Assign the tempValue to compare
For tRow = 2 To lastTargetRow 'Loop through entire target sheet
If Sheets(target).Cells(tRow, "B").Text = tempVal Then
match = True
End If
Next tRow
If match = False Then 'No Match found, copy row
nRow = Sheets(target).Range("A" & Rows.count).End(xlUp).row + 1
For lCol = 1 To 6 'Copy entire row by looping through 6 columns
Sheets(target).Cells(nRow, lCol).Value = Sheets(source).Cells(lRow, lCol).Value
Next lCol
Next lRow
End Sub

Related

Matching values in one column with comma separated values in another column and returning the matched value

I have one column with values like
himaanshu
akshay
rahul
hgeet
And another column with values like
axs,fdvf,dasad
axs,fdvf,dasad, himaanshu
axs,fdvf,dasad, akshay
asz,wesd,hgeet
I need to return the matching name for every row in Column 2 from whole list of Column 1
Solution Should be:
1. None
2. himaanshu
3. akshay
4. hgeet
Can anyone help me with the formula that I can use in spreadsheet to solve this.
Try the below:
Sub test()
Dim str1 As String
Dim rngToSearch As Range, cell As Range
Dim LastRowA As Long, LastrowC As Long, i As Long, y As Long
Dim arr As Variant
With ThisWorkbook.Worksheets("Sheet1")
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastrowC = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rngToSearch = .Range("C2:C" & LastrowC)
For i = 2 To LastRowA
str1 = .Range("A" & i).Value
For Each cell In rngToSearch
arr = Split(cell.Value, ",")
For y = LBound(arr) To UBound(arr)
If Trim(arr(y)) = Trim(str1) Then
.Range("B" & i).Value = str1
End If
Next y
Next cell
Next i
End With
End Sub
Results:
See if this formula works (in a google spreadsheet)
=ArrayFormula(iferror(REGEXEXTRACT(C2:C5, textjoin("|", 1, A2:A5)), "none"))
The formula extracts any of the values in column A from the values in column C
[
=VLOOKUP("*"&A1&"*", B1:B4,1,0)

Access VBA export one row of table to excel spreadsheet, not entire table

I'm attempting to write a loop in VBA for Access 2010, where the loop looks through a table (table: "SunstarAccountsInWebir_SarahTest") and evaluates a number of conditions, and depending on the condition - may then loop through a different table ("1042s_FinalOutput_7") to see if it has an ID that matches. If it does match, it inserts "Test" into a field, if not - it should export that row of values (from the first loop - out of "SunstarAccountsInWebir_SarahTest") into an excel file.
My issue is that my code is exporting the entirety of the table "SunstarAccountsInWebir_SarahTest", I only want it to export the row corresponding to the value of i in the loop. How can I amend my code to do this?
Public Sub EditFinalOutput2()
'set loop variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
'Function GetID(external_nmad_id As String, IRSfileFormatKey As String)
'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")
'set loop for whole recordset(this is the original location, will try putting it within the If, ElseIf loop)
'For i = 0 To qs.RecordCount - 1
With qs.Fields
For i = 0 To qs.RecordCount - 1
If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or (!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 = !nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or (!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
MsgBox "This was an invalid address"
Else:
With ss.Fields
For j = 0 To ss.RecordCount - 1
If (qs.Fields("external_nmad_id") = Right(ss.Fields("IRSfileFormatKey"), 10)) Then
ss.Edit
ss.Fields("box13_Address") = "Test"
ss.Update
Else: DoCmd.TransferSpreadsheet acExport, 10, "SunstarAccountsInWebir_SarahTest", "\\DTCHYB-MNMH001\C_WBGCTS_Users\U658984\My Documents\pre processor\PreProcessor7\ToBeReviewed\AddressesNotActiveThisYear.xlsx", False
End If
ss.MoveNext
Next j
End With
End If
qs.MoveNext
Next i
End With
'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing
End Sub
This ended up being the closest. I needed to switch to a "Do While" loop rather than a second integer loop. The code for so is below:Public Sub EditFinalOutput2()
'set variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
Dim mytestwrite As String
mytestwrite = "No"
'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")
With qs.Fields
For i = 0 To qs.RecordCount - 1
If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or
(!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 =
!nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or
(!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
DoCmd.RunSQL "INSERT INTO Addresses_ToBeReviewed SELECT
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id &
"'));"
Else:
Set ss = db.OpenRecordset("1042s_FinalOutput_7")
With ss.Fields
'if not invalid address, loop through second (final output) table to find
matching ID's
If ss.EOF = False Then
ss.MoveFirst
Do
Dim mykey As String
mykey = Right(ss!IRSfileFormatKey, 10)
Debug.Print mykey
If qs.Fields("external_nmad_id") = mykey Then
ss.Edit
ss.Fields("box13c_Address") = qs.Fields("nmad_address_1") &
qs.Fields("nmad_address_2") & qs.Fields("nmad_address_3")
ss.Update
mytestwrite = "Yes"
End If
ss.MoveNext
'if the valid address doesn't match to final output table, add to list of
addresses not matched
Loop Until ss.EOF
If mytestwrite = "No" Then
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Addresses_NotUsed SELECT
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id &
"'));"
DoCmd.SetWarnings True
End If
End If
End With
End If
qs.MoveNext
Next i
End With
'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing
End Sub
Ok, based on your stated goal, there are a few errors in your approach.
Here is how I understand your goal based on your opening paragraph:
Loop through each record in table TableA. If the record meets
certain complex criteria, search a second table TableB to see if any
records in TableB contain a matching ID value from this record in
TableA. If a match exists, update a field in TableB, otherwise, export the record from TableA to Excel.
I will describe how the code you have presented is processing your data, and then I will explain how I would approach this problem.
First, as #ScottHoltzman alluded, the DoCmd.TransferSpreadsheet statement that you have in your code will, of course, transfer the entire table to Excel because that is what you told it to do. The 3rd parameter specifies the data to be exported, and you gave it the full table name, so the full table will be exported.
Second, I think you are misunderstanding how looping through the two RecordSets in your code is actually functioning. Your code is doing the following:
Evaluate a record in qs. If it doesn't meet the criteria, move to the next qs record and repeat step 1.
If the record in qs does meet the criteria, evaluate a record in ss against this record in qs.
If they match, update ss and move to the next ss record, go to step 2, remembering that qs is still pointing at the same record and has not moved.
If they do not match, transfer the entire table to Excel, now move to the next ss record, go to step 2, again remembering that qs is still pointing at the same record and has not moved.
Once all records in ss have been processed through steps 2, 3 & 4, move to the next qs record and go to step 1
I would expect your code to export the table to Excel over and over again many times.
I would also expect your code to get an error as soon as you begin to process the 2nd qs record that moves on to step 2 because after having processed steps 2, 3 & 4 for the first qs record that met your criteria, the ss RecordSet will be pointing at EOF, and you don't have any code to move the pointer back to the first record in ss.
Anyway, since you have a complex criteria for determining if a record is exported or not, I would recommend adding a single True/False field to TableA called ToExport. Now, at the beginning of your code, you would set ToExport = False for all records in TableA. Then, your code would work to evaluate each record in TableA to determine if the record should be exported. If it should, you update ToExport to be True. Once you have looped through the entire table, only the records needing exported will be marked as ToExport = True. Now, you export just the True records to Excel, thereby achieving your desired result.
Here is some code that should achieve this goal in an efficient manner. This code tries to use the tables and criteria from your original source. It also replaces your With blocks and For loops with more useful Do loops, taking advantage of built-in RecordSet looping and EOF checking.
Public Sub EditFinalOutput2()
Dim db As DAO.Database
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb()
strSQL = "UPDATE [SunstarAccountsInWebir_SarahTest] SET ToExport = False;"
db.Execute strSQL
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest", dbOpenDynaset)
Do While Not qs.EOF
If (IsNull(qs("nmad_address_1")) Or (qs("nmad_address_1") = qs("nmad_city")) Or (qs("nmad_address_1") = qs("Webir_Country")) And IsNull(qs("nmad_address_2")) Or (qs("nmad_address_2") = qs("nmad_city")) Or (qs("nmad_address_2") = qs("Webir_Country")) And IsNull(qs("nmad_address_3")) Or (qs("nmad_address_3") = qs("nmad_city")) Or (qs("nmad_address_3") = qs("Webir_Country"))) Then
MsgBox "This was an invalid address"
Else
strSQL = "SELECT * FROM [1042s_FinalOutput_7] WHERE Right([IRSfileFormatKey], 10) = """ & qs("external_nmad_id") & """;"
Set ss = db.OpenRecordset(strSQL, dbOpenDynaset)
If ss.BOF Then
qs.Edit
qs("ToExport") = True
qs.Update
Else
Do While Not ss.EOF
ss.Edit
ss("box13_Address") = "Test"
ss.Update
ss.MoveNext
Loop
End If
ss.Close
End If
qs.MoveNext
Loop
qs.Close
strSQL = "SELECT * FROM [SunstarAccountsInWebir_SarahTest] WHERE ToExport = True;"
DoCmd.TransferSpreadsheet acExport, 10, strSQL, "\\DTCHYB-MNMH001\C_WBGCTS_Users\U658984\My Documents\pre processor\PreProcessor7\ToBeReviewed\AddressesNotActiveThisYear.xlsx", False
Set qs = Nothing
Set ss = Nothing
db.Close
Set db = Nothing
End Sub
I hope this helps you better achieve your goal.
Create a query like this, and execute it, and return dim rst as Recordset
NOTE: I have changed the AND-s to OR-s as that is what I think you want...
Select qs.*
From
(Select *
From SunstarAccountsInWebir_SarahTest
Where Not
(
(IsNull(nmad_address_1)
Or (nmad_address_1 = nmad_city)
Or (nmad_address_1 = Webir_Country)
OR IsNull(nmad_address_2)
Or (nmad_address_2 = nmad_city)
Or (nmad_address_2 = Webir_Country)
OR IsNull(nmad_address_3)
Or (nmad_address_3 = nmad_city)
Or (nmad_address_3 = Webir_Country)
)
) as qs
Left Join
(Select *
,Right(ss.Fields("IRSfileFormatKey"), 10) as ssKey
From 1042s_FinalOutput_7
) as ss
On qs.external_nmad_id = ss.ssKey
Where ssKey is NULL
Then output the rst --(taken from https://support.microsoft.com/en-us/help/246335/how-to-transfer-data-from-an-ado-recordset-to-excel-with-automation )
' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
' Copy the recordset to the worksheet, starting in cell A2
xlWs.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets

Conditional copying two tables SQL Server 2008 on a range

I have two tables and require the first table to be updated as the third screen shot.
This is the first table. The VON is the first value of the range. This value is picked up from the second table till the BIS value is reached. While the BIS value is reached in the second table, the RANGE column is updated with the values between VON and BIS values.
The second table contains sequentially listed values from 01 to 99 and alphanumeric values such as A1, A2 etc.
Any suggestions?
Try This:
Option Explicit
Sub ExpandRows()
Dim rgLastCell As Range
Dim rgThisRow As Range
Dim wsMaster As Worksheet
Dim wsNewSheet As Worksheet
Dim rgThisRecord As Range
Dim intVon As Integer
Dim intRes As Integer
Dim dblCopyRowNumber As Double
Set wsMaster = ActiveSheet
Set wsNewSheet = Worksheets.Add(after:=wsMaster)
wsNewSheet.Name = "Output"
Set rgLastCell = GetLastCell(wsMaster)
dblCopyRowNumber = 2
wsMaster.Rows(1).Copy wsNewSheet.Range("A1")
wsmaster.columns.autofit
For Each rgThisRow In Range("A2:A" & rgLastCell.Row)
Set rgThisRecord = wsMaster.Range(Cells(rgThisRow.Row, 1).Address, Cells(rgThisRow.Row, rgLastCell.Column).Address)
Debug.Print rgThisRecord.Address
If IsNumeric(rgThisRecord(8)) Then
intVon = rgThisRecord(8).Value
intRes = rgThisRecord(9).Value
While intVon <= intRes
rgThisRecord.Copy wsNewSheet.Range("A" & dblCopyRowNumber)
wsNewSheet.Cells(dblCopyRowNumber, 11).Value = intVon
dblCopyRowNumber = dblCopyRowNumber + 1
intVon = intVon + 1
Wend
Else
rgThisRecord.Copy wsNewSheet.Range("A" & dblCopyRowNumber)
dblCopyRowNumber = dblCopyRowNumber + 1
End If
Next
Set rgLastCell = Nothing
Set rgThisRow = Nothing
Set wsMaster = Nothing
Set wsNewSheet = Nothing
Set rgThisRecord = Nothing
End Sub
and this is the find last cell function:
Function GetLastCell(ByVal wsCurrentSheet As Worksheet) As Range
Dim rgLastRow As Range
Dim rglastColumn As Range
Dim rgLastCell As Range
Set rgLastRow = wsCurrentSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
Set rglastColumn = wsCurrentSheet.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious)
Set GetLastCell = wsCurrentSheet.Cells(rgLastRow.Row, rglastColumn.Column)
Set rgLastCell = Nothing
Set rgLastRow = Nothing
Set rglastColumn = Nothing
End Function
Hope that helps.

Excel VBA: Insert cell in a table from searching another table

It's been years since I last had to code anything, but now I seem to need it again.
To simplify, I have number 7 in column A, and I need to input another number in column B depending on what number 7 relates to in another table in another sheet.
So in Sheet2 another table has numbers ranging from 1 to 10 in column A, and according numbers in column B. I then need it to search for number 7 in column A of sheet2 and give me the number in column B, and place it in column B in the first sheet.
I have tried a For loop inside a For loop, based on another code I found somewhere, but it's been so long ago I would need to spend hours rereading and trying to get near a solution. Maybe this is an easy thing for advanced coders?
Anyways, thanks in advance for the help!
couldn't you ever help without VBA then you can use this
Option Explicit
Sub main()
Dim cell As Range, f As Range
Dim rng1 As Range, rng2 As Range
Set rng1 = Worksheets("Sht1").Columns(1).SpecialCells(xlCellTypeConstants) '<--Change "Sht1" to your actual sheet1 name
Set rng2 = Worksheets("Sht2").Columns(1).SpecialCells(xlCellTypeConstants) '<--Change "Sht2" to your actual sheet2 name
For Each cell In rng1
Set f = rng2.Find(what:=cell.Value2, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=xlNo)
If Not f Is Nothing Then cell.Offset(, 1) = f.Offset(, 1)
Next cell
End Sub
Here are two ways of doing searching over two tables.
Sub LoopValues()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim wsSource As Worksheet, wsSearch As Worksheet
Dim sourceLastRow As Long, searchLastRow As Long
Dim i As Long, j As Long
Set wsSource = Worksheets("Sheet3")
Set wsSearch = Worksheets("Sheet4")
With wsSource
sourceLastRow = .Range("A" & Rows.Count).End(xlUp).Row
searchLastRow = wsSearch.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To sourceLastRow
For j = 2 To sourceLastRow
If .Cells(i, 1).Value = wsSearch.Cells(j, 1).Value Then .Cells(i, 2).Value = wsSearch.Cells(j, 2).Value
Next
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub FindValuesLoop()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim wsSource As Worksheet, wsSearch As Worksheet
Dim sourceLastRow As Long
Dim i As Long
Dim SearchRange As Range, rFound As Range
Set wsSource = Worksheets("Sheet3")
Set wsSearch = Worksheets("Sheet4")
With wsSource
sourceLastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set SearchRange = wsSearch.Range(wsSearch.Range("A1"), wsSearch.Range("A" & Rows.Count).End(xlUp))
For i = 2 To sourceLastRow
Set rFound = SearchRange.Find(What:=.Cells(i, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rFound Is Nothing Then .Cells(i, 2).Value = rFound.Offset(0, 1).Value
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Parse data from one CSV file to another

I'm trying to run this Macro but since my CSV file is really long and I don't want to count the column numbers, is there a way to reference the column by the letters such as "DZ"? The code works fine but I just need to reference these deep columns and don't want to count which column number it is and can't seem to find a way to display the column number. I have been setting 'c' & 't' as the column number such as 1, 2, etc.
Sub ParseColumn
Dim sheet1 as Object
Dim sheet2 as Object
Dim r as long
Dim c as long
sheet1 = ThisComponent.Sheets.getbyname("Sheet1")
sheet2 = ThisComponent.Sheets.getbyname("Sheet2")
c = F
t = DZ
for r = 1 to 18739
copyFrom = sheet1.getCellByPosition(c,r)
copyTo = sheet2.getCellByPosition(t,r)
copyTo.String = copyFrom.String
next r
End Sub
Update
Found a solution:
Sub ParseColumn
Dim sheet1 as Object
Dim sheet2 as Object
Dim r as long
sheet1 = ThisComponent.Sheets.getbyname("Sheet1")
sheet2 = ThisComponent.Sheets.getbyname("Sheet2")
for r = 2 to 18739
copyFrom = sheet1.getCellRangeByName("AR" & r)
copyTo = sheet2.getCellRangeByName("S" & r)
copyTo.String = copyFrom.String
next r
End Sub