Copy description from one cell to another

Panoos64 · Feb 5, 2019

Hi all, I would like to use a VBA code, so that to run through col “B” and where find the name of each department, e.g. Restaurant, Pool bar e.t.c., should place it in col. “F” and rows down for each department’s records. Therefore, that the rows are 100000+. I present below the original data and the expected result. Thank you in advance

Original data

	A	B	C	D	E	F	G	H	I
4	Department:	Restaurant
5
6							Opening Balance		250.22
7	Date	Tns Type	Inv. #	Waybil #	Trns #	Department	Description	Debit	Credit
8		ISSUE			1345		Cereals 500gr	650.22	0
9		INVC			2578		Cans 100gr	1010.6	0
10
11	Department:	Pool Bar
12
13							Openoing Balance	178.45
14	Date	Tns Type	Inv. #	Waybil #	Trns #	Department	Description	Debit	Credit
15		TRSF			259		Red Wines 75cl	0	78.75
16		CR.NOTE			85		White Wines 75cl	0	65.24
17		INVC			2696		Whiskies 75cl	350.78	0

Expected result

	A	B	C	D	E	F	G	H	I
4	Department:	Restaurant
5
6							Opening Balance		250.22
7	Date	Tns Type	Inv. #	Waybil #	Trns #	Department	Description	Debit	Credit
8		ISSUE			1345	Restaurant	Cereals 500gr	650.22	0
9		INVC			2578	Restaurant	Cans 100gr	1010.6	0
10
11	Department:	Pool Bar
12
13							Opening Balance	178.45
14	Date	Tns Type	Inv. #	Waybil #	Trns #	Department	Description	Debit	Credit
15		TRSF			259	Pool Bar	Red Wines 75cl	0	78.75
16		CR.NOTE			85	Pool Bar	White Wines 75cl	0	65.24
17		INVC			2696	Pool Bar	Whiskies 75cl	350.78	0

steve the fish · Feb 5, 2019

Presuming your sample is representative of all the data try:

Code:

Dim sh As Worksheet, lr As Long, arr, i As Long, dept As String

Set sh = ActiveSheet

With sh
    lr = .Cells(.Rows.Count, "B").End(xlUp).Row
    arr = .Range("A1:F" & lr)
    For i = LBound(arr) To UBound(arr)
        If arr(i, 1) = "Department:" Then dept = arr(i, 2)
        If dept <> "" Then
            If arr(i, 1) = vbNullString And arr(i, 2) <> vbNullString Then
               arr(i, 6) = dept
            End If
        End If
    Next
    .Range("A1:F" & lr) = arr
End With

Panoos64 · Feb 5, 2019

Thank you steve, it works perfect and based on my data. Thanks also for your time spent for my project. Hv a great day!

Panoos64 · Feb 5, 2019

Apologies steve, there are data (is the Date) in col. "A" and i didn't enter in my above extract. Due to this the code it doesn't run. Please can u modify it? I would much appreciate. Apologies once again for any inconvenience i caused.

steve the fish · Feb 5, 2019

Try changing the line to:

Code:

If (arr(i, 1) = vbNullString Or IsDate(arr(i, 1))) And arr(i, 2) <> vbNullString Then

Panoos64 · Feb 5, 2019

Thank u steve for your prompt respond. Is perfect now. My best wishes!

Copy description from one cell to another

Panoos64

Well-known Member

Excel Facts

steve the fish

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

steve the fish

Well-known Member

Panoos64

Well-known Member

Similar threads

Forum statistics

Share this page

Copy description from one cell to another

Panoos64

Well-known Member

Excel Facts

steve the fish

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

steve the fish

Well-known Member

Panoos64

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock