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

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
439
Office Version
  1. 2019
Platform
  1. Windows
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.
RowsColumn AColumn D
82020-10-01 @ 15:13
92020-10-01 @ 16:19
102020-10-02 @ 2:30
112020-10-04 @ 5:30
122020-10-05 @ 14:30

Table 2: I would like the final result to look like this:
RowsColumn AColumn D
82020.10.01.00012020-10-01 @ 15:13
92020.10.01.00022020-10-01 @ 16:19
102020.10.02.00032020-10-02 @ 2:30
112020.10.04.00042020-10-04 @ 5:30
122020.10.05.00052020-10-05 @ 14:30

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

VBA Code:
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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Hi

does the below work for you.

dave


VBA Code:
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
 
Upvote 0
Hi

does the below work for you.

dave


VBA Code:
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?
VBA Code:
Dim lr as Long
Dim a as Long
Dim b as Long
 
Upvote 0
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"

VBA Code:
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
 
Upvote 0
try this
VBA Code:
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
 
Last edited:
Upvote 0
try this
VBA Code:
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.

RowsColumn AColumn D
82020.10.01.00012020-10-01 @ 15:13
202020.10.10.00132020-10-10 @ 1:00
3002020.10.02.02932020-10-02 @ 2:30
18052020.10.04.17982020-10-04 @ 5:30
21732020.10.05.21662020-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.

VBA Code:
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
 
Upvote 0
Solution
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,997
Messages
6,175,872
Members
452,679
Latest member
darryl47nopra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top