# formula/macro? to copy value below without overwriting.....

#### Mcthree

##### New Member
without overwriting the next value to be copied? Hi, I am trying to copy and paste a four digit department in front of the expense code below it. The problem is, I have approx 80 departments and dont want to spend all day copying and pasting each one in front of however many expenses they have. The data looks like this

8415 Finance
100 Salaries
200 Benefits

7809 Homecare
100 Salaries
200 Benefits
300 All Other

I would like it to read:

8415 Finance
8415 100 Salaries
8415 200 Benefits

7809 Homecare
7809 100 Salaries
7809 200 Benefits
7809 300 All Other

I plan to Concatenate these completed departments with expenses and then do a VLookup to Downloads from our General Ledger to project our Budget with as much real time info possible. But first I must build it.

Thanks in advance for the help.

James

### Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
James

How can you identify a department from the expense? Is the first row of a "block" always going to be the department and everything below going to be an expense, until you meet a blank row?

Is the Department identifier always going to be the first 4 characters?

Tony

Hi -
Welcome to the Mr. Excel Board.
Is your original data laid out like this?
Book1
ABCD
18415Finance
2100Salaries
3200Benefits
4
57809Homecare
6100Salaries
7200Benefits
8300All other
Sheet1

Also, is there always blank row after each department?

hope this works for you...
Code:
``````Sub sample()
Dim a, i As Long
a = Range("a1",Range("a" & Rows.Count).End(xlUp)).Resize(,2).Value
ReDim result(1 To UBound(a,1), 1 To 3)
For i = 1 To UBound(a,1)
If Len(Trim(a(i,1))) = 4 Then
n = n + 1 : result(n, 1) = a(i,1) : result(n,2) = a(i,2) : t = 1
Do Until Len(a(i + t,1)) <> 3
n = n + 1
result(n,1) = a(i,1)
result(n,2) = a(i + t, 1)
result(n,3) = a(i + t, 2)
t = t + 1
If i + t > UBound(a,1) Then Exit Do
Loop
i = i + t - 1 : n = n + 1
End If
Next
Range("D1").Resize(n-1,3).Value = Result
Erase a, result
End Sub``````
Dited: code

Jindon -

this produce error
Code:
``n + n + 1``

Jindon -

this produce error
Code:
``n + n + 1``
Thanks, code modified.

Jindon -

Subscript out of range
Code:
``n = n + 1: result(n, 1) = a(i, 1): result(n, 2) = a(i, 2): t = 1``

highlight result(n, 2) = a(i, 2)

Jindon -

Subscript out of range
Code:
``n = n + 1: result(n, 1) = a(i, 1): result(n, 2) = a(i, 2): t = 1``

highlight result(n, 2) = a(i, 2)
Thanks for testing, code modified.

out of range;
Code:
``Do Until Len(a(i + t, 1))<> 3``
I was hoping that the output should be like this. Am I correct?
Book1
DEFG
18415Finance
28415100Salaries
38415200Benefits
48415300All other
5
67809Homecare
77809100Salaries
87809200Benefits
97809300All other
Sheet1

Yep! (hope so)

code modified..

Replies
1
Views
252
Replies
9
Views
425
Replies
29
Views
551
Replies
6
Views
402
Replies
2
Views
737

1,203,384
Messages
6,055,118
Members
444,763
Latest member
Jaapaap

### 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.

### Which adblocker are you using?

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

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