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

[Mcthree]

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

 

[acw]

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

 

[agihcam]

Hi -
Welcome to the Mr. Excel Board.
Is your original data laid out like this?

Book1
	A	B	C	D
1	8415	Finance
2	100	Salaries
3	200	Benefits
4
5	7809	Homecare
6	100	Salaries
7	200	Benefits
8	300	All other
Sheet1

Also, is there always blank row after each department?

 

[jindon]

hope this works for you...

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

 

[agihcam]

Jindon -

this produce error

n + n + 1

 

[jindon]

Jindon -

this produce error

n + n + 1

Thanks, code modified.

 

[agihcam]

Jindon -

Subscript out of range

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]

Jindon -

Subscript out of range

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.

 

[agihcam]

out of range;

Do Until Len(a(i + t, 1))<> 3

I was hoping that the output should be like this. Am I correct?

Book1
	D	E	F	G
1	8415	Finance
2	8415	100	Salaries
3	8415	200	Benefits
4	8415	300	All other
5
6	7809	Homecare
7	7809	100	Salaries
8	7809	200	Benefits
9	7809	300	All other
Sheet1

 

[jindon]

Yep! (hope so)

code modified..