Change VBA code to use two values instead of one

[RobertHamberg]

I got help to write a VBA-code that register values to a table based on data in one cell. I need to rewrite it so it uses to values instead of one. The first picture is how it is now, but in the second picture I have how I want it to be. I want the vba-code to use de value in A1 AND A2 when saving data to the sheet "Cars"

Sub SaveCar()
Dim vFoundDate, vFoundOmr
Dim SearchRange As Range
Dim dCar
Dim firstrow, lastrow, r, iStartrow, iStoprow
iStartrow = 3
iStoprow = 9
dCar = Sheets("Reg").Range("rSearchReg").Value
Call SortCars
Set vFoundDate = Sheets("Cars").Range("A:A").Find(dCar)
If Not vFoundDate Is Nothing Then
firstrow = Sheets("Cars").Range("A:A").Find(dCar, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
lastrow = Sheets("Cars").Range("A:A").Find(dCar, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set SearchRange = Range(Sheets("Cars").Range("A:A").Range("B" & firstrow), Sheets("Cars").Range("B" & lastrow))
For r = iStartrow To iStoprow
If Not Sheets("Reg").Range("B" & r).Value = "" Then
Set vFoundOmr = SearchRange.Find(Sheets("Reg").Range("A" & r).Value)
If Not vFoundOmr Is Nothing Then
vFoundOmr.Offset(0, 1) = Sheets("Reg").Range("B" & r).Value
Else
lastrow = Sheets("Cars").Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets("Cars").Range("A" & lastrow + 1).Value = dCar
Sheets("Cars").Range("B" & lastrow + 1).Value = Sheets("Registrering").Range("A" & r).Value
Sheets("Bilar").Range("C" & lastrow + 1).Value = Sheets("Registrering").Range("B" & r).Value
End If
End If
Next r
Else
For r = iStartrow To iStoprow
If Not Sheets("Reg").Range("B" & r).Value = "" Then
lastrow = Sheets("Cars").Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets("Cars").Range("A" & lastrow + 1).Value = dCar
Sheets("Cars").Range("B" & lastrow + 1).Value = Sheets("Reg").Range("A" & r).Value
Sheets("Cars").Range("C" & lastrow + 1).Value = Sheets("Reg").Range("B" & r).Value
End If
Next r
End If
Call SortCars
End Sub

 

[DanteAmor]

What you put is the latest version of your code?
I assume you are passing values from sheet "Reg" to sheet "Cars" but you have 3 lines of code with different sheets.

I need to rewrite it so it uses two values instead of one.

What do you want to do with the second value (date)?
You only want to pass the date, where do you want to put it?
Or do you want to search using the 2 values?
It would help a lot, if you put examples of what you have. But it is also very important that you put the result that you want.
To put data ranges use the XL2BB tool, see my signature.

 

[RobertHamberg]

Thanks for replying!

View attachment 20536

What you put is the latest version of your code?
I assume you are passing values from sheet "Reg" to sheet "Cars" but you have 3 lines of code with different sheets.

Sorry, I was changing the language in the code from swedish to english before posting but forgot to change these 3 lines "Bilar" = "Cars" and "Registrering" = "Reg"

What do you want to do with the second value (date)?
You only want to pass the date, where do you want to put it?
Or do you want to search using the 2 values?
It would help a lot, if you put examples of what you have. But it is also very important that you put the result that you want.
To put data ranges use the XL2BB tool, see my signature.

I want the code to treat the second value equal to the first. So when I use this code to save the vales from sheet "Cars" to sheet "Reg" I want a table that looks like this:

On the next code (not posted yet) I want to search the table on sheet "Reg" for matching lincensplate and date and return the values on those rows so I can be able to change them if needed.

 

[DanteAmor]

It would help a lot, if you put examples of what you have. But it is also very important that you put the result that you want.
To put data ranges use the XL2BB tool, see my signature.

Help me with that

 

[RobertHamberg]

Mätarställningar 2020.xlsm
	A	B	C	D
1	Reg.nummer
2
3	Modell
4	Märke
5	Årsmodell
6	Kontaktperson
7	Kostnadsställe
8	Kostnadsställe_text
9	Drivmedel
Registrering

Doesnt look like this captures the VBA-code?

 

[DanteAmor]

Doesnt look like this captures the VBA-code?

The XL2BB tool does not capture the VBA code only data and formulas from a range of the sheet.

There are some things that I don't understand in your macro.
So I want to see what you have and what result you want.
Thanks for using XL2BB tool, but you put the previous version, I want you to put your new layout with example data, because I suppose that in column B you put data, so I want to see that example data.
And it is also very important that you put the expected result on the "Bilar" sheet.

 

[DanteAmor]

I get it.

Fisrt data:

Dante Amor
	A	B
1	Reg.nummer	Reg123
2	Date	20/08/2020
3
4	Modell	value1
5	Märke	value2
6	Årsmodell	value3
7	Kontaktperson
8	Kostnadsställe
9	Kostnadsställe_text
10	Drivmedel
Registrering

Before the macro:

Dante Amor
	A	B	C	D
1	Date	Reg.nummer	Type	Value
2
3
4
5
6
7
8
9
10
Bilar

After the macro:

Dante Amor
	A	B	C	D
1	Date	Reg.nummer	Type	Value
2	20/08/2020	Reg123	Modell	value1
3	20/08/2020	Reg123	Märke	value2
4	20/08/2020	Reg123	Årsmodell	value3
5
6
7
8
9
10
Bilar

Try this:

Sub Save_Bilar()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, dic As Object, reg As String
  Dim i As Long, j As Long, lr As Long
  '
  Set sh1 = Sheets("Registrering")                      'source sheet
  Set sh2 = Sheets("Bilar")                             'output sheet
  Set dic = CreateObject("Scripting.Dictionary")
  '
  lr = sh2.Range("A" & Rows.Count).End(3).Row
  j = lr + 1
  a = sh2.Range("A1:D" & lr + 7).Value2                 'data in bilar. + 7: because they are 7 types
  '
  For i = 1 To UBound(a, 1)
    dic(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) = i    'bilar: date | numm | type
  Next
  '
  For i = 4 To 10
    If sh1.Range("B" & i) <> "" Then
      reg = sh1.Range("B2").Value2 & "|" & sh1.Range("B1").Value2 & "|" & sh1.Range("A" & i) 'date | numm | type
      If Not dic.exists(reg) Then
        a(j, 1) = sh1.Range("B2").Value
        a(j, 2) = sh1.Range("B1").Value
        a(j, 3) = sh1.Range("A" & i).Value
        a(j, 4) = sh1.Range("B" & i).Value
        j = j + 1
      Else
        a(dic(reg), 4) = sh1.Range("B" & i).Value
      End If
    End If
  Next
  sh2.Range("A1").Resize(j, 4).Value = a
End Sub

 

[RobertHamberg]

Works great! Thanks alot!

Ive noticed that it adds an extra row on the output sheet with #N/A. It only happens when new rows are added, not when old rows are overwritten.

 

[DanteAmor]

Ive noticed that it adds an extra row on the output sheet with #N/A.

Did you modify something in the macro?

Can you describe the steps you take when the "#NA" happens

 

[RobertHamberg]

Did you modify something in the macro?

Can you describe the steps you take when the "#NA" happens

No, didnt modify.

I added values in the source sheet, then activated the macro and got this on the output sheet.