How can I increment column value in excel VBA? - excel

Question

I have 2 excel sheets one is mapping and other is soneri. I want to increment the values of Column D in soneri sheet which was get by lookup function. What is the mistake in my code?
soneri sheet
mappingsheet
Outcome
Column D
Only first 2 rows are correct of my outcome else are wrong.
Expected Outcome
Below is my code
"WORKING CODE EDITED"
Sub ButtonClick()
Dim soneriWs As Worksheet, mappingWs As Worksheet
Dim sonerilastrow As Long, mappinglastrow As Long, i As Long
Dim datarange As Range, assetrange As Range, b As Range
Dim entry As Variant
Set soneriWs = ThisWorkbook.Worksheets("Soneri")
Set mappingWs = ThisWorkbook.Worksheets("Mapping")
sonerilastrow = soneriWs.Range("I" & soneriWs.Rows.Count).End(xlUp).Row
mappinglastrow = mappingWs.Range("A" & mappingWs.Rows.Count).End(xlUp).Row
Set datarange = mappingWs.Range("A2:B" & mappinglastrow)
Set assetrange = soneriWs.Range("I2:I" & sonerilastrow)
i = 0
For Each entry In assetrange
Set b = entry.Offset(, -5)
b = Application.WorksheetFunction.VLookup(entry, datarange, 2, False)
If entry = entry.Offset(-1) Then
i = i + 1
b = Left(b, Len(b) - 1) & (Right(b, 1) + i)
Else
i = 0
End If
Next entry
End Sub

Answer 1

Rows.Count returns that number of rows for the active sheet. Try changing these two lines:
sonerilastrow = soneriWs.Range("I" & Rows.Count).End(xlUp).Row
mappinglastrow = mappingWs.Range("A" & Rows.Count).End(xlUp).Row
To this:
sonerilastrow = soneriWs.Range("I" & soneriWs.Rows.Count).End(xlUp).Row
mappinglastrow = mappingWs.Range("A" & mappingWs.Rows.Count).End(xlUp).Row
Also remember to clear any errors that might occur, otherwise you can run into trouble. Insert this before the Sub returns:
If Err <> 0 Then Err.Clear
I see you removed your "on error" statement.
I would also recommend that you force variable decalarations, as I can see you use undeclared variables, which will also get you into trouble sooner or later. Insert this as the first line in all modules:
Option Explicit
EDIT:
Please post test data "as text" next time to help people help you.
Here is a solution.
I uncommented your if statement, as it seem to not update the first record.
Sub ButtonClick()
Dim soneriWs As Worksheet, mappingWs As Worksheet
Dim sonerilastrow As Long, mappinglastrow As Long, x As Long, b As String, c As String
Dim Dct As Object
Dim Cnt As Long
Dim CntTxt As String
Dim PreTxt As String
Dim Idx As Long
Dim datarange As Range
Set soneriWs = ThisWorkbook.Worksheets("Soneri")
Set mappingWs = ThisWorkbook.Worksheets("Mapping")
sonerilastrow = soneriWs.UsedRange.Rows.Count
mappinglastrow = mappingWs.UsedRange.Rows.Count
Set Dct = CreateObject("Scripting.Dictionary")
Set datarange = mappingWs.Range("A2:B" & mappinglastrow)
For x = 2 To sonerilastrow
b = Application.WorksheetFunction.VLookup(soneriWs.Range("I" & x).Value, datarange, 2, False)
Idx = InStr(b, "-")
PreTxt = Left(b, Idx)
CntTxt = Mid(b, Idx + 1)
If Dct.Exists(b) Then
Cnt = Dct(b) + 1
Else
Cnt = Val(CntTxt)
End If
Dct(b) = Cnt
'If x > 2 Then
c = PreTxt & Format(Cnt, "0000")
' Use this instead, if you want to preserve the number of characters
'c = PreTxt & Format(Cnt, String(Len(CntTxt), "0"))
soneriWs.Range("D" & x).Value = c
'End If
Next x
End Sub
If you are new to VBA I recommend that you learn how to use the Scripting.Dictionary.

Answer 2

Your loop is only made for a single match of the Asset class.
There are a few problems here, but the if x > 2 approach would really only work if there was only one counter. Then we could substitute + 1 with something like + x - 2 (since we start at 3 for this part of the code).
But what you need is a counter that resets each time there is a new Asset class.
n = 1
For x = 2 To sonerilastrow
b = Application.WorksheetFunction.VLookup( _
soneriWs.Range("I" & x).Value, datarange, 2, False)
soneriWs.Range("D" & x).Value = b
If x > 2 Then
If Not Left(b, 7) = Left(soneriWs.Range("D" & x -1).Value, 7) then
n = 1
else
c = Left(b, 7) & Format(Val(Right(b, 4)) + n, "-0000")
soneriWs.Range("D" & x).Value = c
n = n + 1
End if
End If
Next x
Another way of writing it would be
Dim soneriWs As Worksheet, mappingWs As Worksheet
Dim sonerilastrow As Long, mappinglastrow As Long, i As Long
Dim datarange As Range, assetrange As Range, b As Range
Dim entry As Variant
Set soneriWs = ThisWorkbook.Worksheets("Soneri")
Set mappingWs = ThisWorkbook.Worksheets("Mapping")
sonerilastrow = soneriWs.Range("I" & soneriWs.Rows.Count).End(xlUp).Row
mappinglastrow = mappingWs.Range("A" & mappingWs.Rows.Count).End(xlUp).Row
Set datarange = mappingWs.Range("A2:B" & mappinglastrow)
Set assetrange = soneriWs.Range("I2:I" & sonerilastrow)
i = 0
For Each entry In assetrange
Set b = entry.Offset(, -5)
b = Application.WorksheetFunction.VLookup(entry, datarange, 2, False)
If entry = entry.Offset(-1) Then
i = i + 1
b = Left(b, Len(b) - 1) & (Right(b, 1) + i)
Else
i = 0
End If
Next entry
But it's using much the same approach.
These however expect the data to be sorted on the "I" column, since the counter will reset if there is another asset in between.
If you want it to work even when not sorted, you could use something like countIf, like so: (Replacing the loop)
Set assetrange = soneriWs.Range("I2:I" & sonerilastrow)
assetrange.Offset(, -5).Clear
For Each entry In assetrange
Set b = entry.Offset(, -5)
b = Application.WorksheetFunction.VLookup(entry, datarange, 2, False)
i = Application.WorksheetFunction.CountIf(assetrange.Offset(, -5), Left(b, 5) & "*")
b = Left(b, Len(b) - 1) & (Right(b, 1) + i - 1)
Next entry