VBA Code to Combine Two Columns where one is an existing column

[OilEconomist]

Thanks in advance. After searching I have found sites to get part of what I would like, but nothing with the final values.
I have a column A which is empty and with range of cells from A8 to A & LastRow, where I determine the last row, I would like to extract the first 10 characters of Column D8 to D & LastRow but also number column A and then combine them in A.

I would like create a VBA Sub/Macro to get the current sheet (Table 1) to look like my final sheet (Table 2).

Table 1: This table has what I have now.

Rows	Column A	Column D
8		2020-10-01 @ 15:13
9		2020-10-01 @ 16:19
10		2020-10-02 @ 2:30
11		2020-10-04 @ 5:30
12		2020-10-05 @ 14:30

Table 2: I would like the final result to look like this:

Rows	Column A	Column D
8	2020.10.01.0001	2020-10-01 @ 15:13
9	2020.10.01.0002	2020-10-01 @ 16:19
10	2020.10.02.0003	2020-10-02 @ 2:30
11	2020.10.04.0004	2020-10-04 @ 5:30
12	2020.10.05.0005	2020-10-05 @ 14:30

VBA Code Start (not much, but wanted to include something to start with:
Option Explicit

Public Sub CmbCol()

    '__________________________________________________________________________________________
    'Turn off alerts, screen updates, and automatic calculation
        'Turn off Display Alerts
            Application.DisplayAlerts = False

        'Turn off Screen Update
            Application.ScreenUpdating = False

        'Turn off Automatic Calculations
            Application.Calculation = xlManual
            


    '__________________________________________________________________________________________
    'Dimensioning
        Dim LastRow As Long
        
    


    '__________________________________________________________________________________________
    'Code
        
        Sheets("Sheet1").Activate
        LastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
    
    

    '_________________________________________________________________________________________________________________
    'Turn on alerts, screen updates, and calculate
        'Turn On Display Alerts
            Application.DisplayAlerts = True

        'Turn on Screen Update
            Application.ScreenUpdating = True

        'Turn off Automatic Calculations
            Calculate


End Sub

 

[SQUIDD]

Hi

does the below work for you.

dave

Sub combine()
lr = Range("d" & Rows.Count).End(xlUp).Row
b = 1
For a = 8 To lr
    If Len(b) = 1 Then c = "000" & b
    If Len(b) = 2 Then c = "00" & b
    If Len(b) = 3 Then c = "0" & b
    If Len(b) = 4 Then c = b
    Range("a" & a) = Left(Range("d" & a), 10) & "." & c
    b = b + 1
Next a
End Sub

 

[OilEconomist]

Hi

does the below work for you.

dave

Sub combine()
lr = Range("d" & Rows.Count).End(xlUp).Row
b = 1
For a = 8 To lr
    If Len(b) = 1 Then c = "000" & b
    If Len(b) = 2 Then c = "00" & b
    If Len(b) = 3 Then c = "0" & b
    If Len(b) = 4 Then c = b
    Range("a" & a) = Left(Range("d" & a), 10) & "." & c
    b = b + 1
Next a
End Sub

Thanks so much for your quick response Dave(@SQUIDD). I'm a bit lost on what you did and I tried it and it did not work as first of all the variables are not declared. But even after trying to declare some of the variables it did not work.

Can you add comments with what exactly you are doing. For example, with b, why are you finding the length of it?

Are the following declarations correct?

Dim lr as Long
Dim a as Long
Dim b as Long

 

[SQUIDD]

hi

ok, what what exactly did not fork for you out of intrest.

I have your data in range d8 to d12, then run my code and i get the results in column a as per you example?


dave

Sub combine()
lr = Range("d" & Rows.Count).End(xlUp).Row 'finds the lastrow in column D
b = 1 'set b as 1 so we start at "0001"

For a = 8 To lr

    'working out how many 0's to add into the string
    If Len(b) = 1 Then c = "000" & b 'if b is single digit the add 3 preceeding 0's
    If Len(b) = 2 Then c = "00" & b 'if b is double digits the add 2 preceeding 0's
    If Len(b) = 3 Then c = "0" & b 'if b is triple digits the add 1 preceeding 0's
    If Len(b) = 4 Then c = b 'if b is quad digit the add 0 preceeding 0's
    Range("a" & a) = Left(Range("d" & a), 10) & "." & c 'writes the left 10 charracters from d, adds the full stop and the number dimmed as c at this point
    b = b + 1 'adds 1 to b to make the next look "0002" and so on

Next a 'next loop

End Sub

 

[SQUIDD]

try this

Sub combine()
Dim lr As Long
Dim a As Integer
Dim b As Integer
Dim c As String
lr = Range("d" & Rows.Count).End(xlUp).Row
b = 1
For a = 8 To lr
    If Len(b) - 1 = 1 Then c = "000" & b
    If Len(b) - 1 = 2 Then c = "00" & b
    If Len(b) - 1 = 3 Then c = "0" & b
    If Len(b) - 1 = 4 Then c = b
    Range("a" & a) = Left(Range("d" & a), 10) & "." & c
    b = b + 1
Next a
End Sub

 

[OilEconomist]

try this

Sub combine()
Dim lr As Long
Dim a As Integer
Dim b As Integer
Dim c As String
lr = Range("d" & Rows.Count).End(xlUp).Row
b = 1
For a = 8 To lr
    If Len(b) - 1 = 1 Then c = "000" & b
    If Len(b) - 1 = 2 Then c = "00" & b
    If Len(b) - 1 = 3 Then c = "0" & b
    If Len(b) - 1 = 4 Then c = b
    Range("a" & a) = Left(Range("d" & a), 10) & "." & c
    b = b + 1
Next a
End Sub

Thanks so much for your assistance and once again your prompt response. After I used your modified code where you included the dimensions, it ran with no simulation/running errors. BUT, I apologize because now that I view my initial request, I did not provide a thorough enough example/result of what I wanted. I think the code you provided does suffice for what my request seemed like. I was able to make changes to the code you provided so it worked for my case. Had you not provided your solution, I would still be here trying to figure out what to do.

Based on my example, it did always put three 0s as it seemed that's what I was requesting. This is what I should have provided as the example.

Rows	Column A	Column D
8	2020.10.01.0001	2020-10-01 @ 15:13
20	2020.10.10.0013	2020-10-10 @ 1:00
300	2020.10.02.0293	2020-10-02 @ 2:30
1805	2020.10.04.1798	2020-10-04 @ 5:30
2173	2020.10.05.2166	2020-10-05 @ 14:30

The following is my modified code. Note that I was not going to have more than 9,999 lines which I should have also included in my initial request/description. But, I'm curious how it could be made dynamic for such as case.

Sub combine()

Dim lr As Long
Dim a As Integer
Dim b As Integer
Dim c As String

lr = Range("d" & Rows.Count).End(xlUp).Row

b = 1

For a = 8 To lr
    If  b < 10 Then c = "000" & b
    If  b > 9 and b < 100 Then c = "00" & b
    If  b > 99 and b < 1000 Then c = "0" & b
    If  b > 999 Then c = b

    Range("a" & a) = Left(Range("d" & a), 10) & "." & c
    b = b + 1

Next a

End Sub

 

[SQUIDD]

Hi

So glad you got it all working.

I think once "b" becomes more the 999, the code would continue to work, just without any preceeding 0's.

Dave

 

[OilEconomist]

Hi

So glad you got it all working.

I think once "b" becomes more the 999, the code would continue to work, just without any preceeding 0's.

Dave

Once again thanks! After 999, I would just need to keep creating the conditions for every increment. At some point I may look at trying to make it more dynamic.

 

[SQUIDD]

your welcome