ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copy Row Above, with a Twist Q (https://www.excelbanter.com/excel-programming/453033-copy-row-above-twist-q.html)

[email protected]

Copy Row Above, with a Twist Q
 
I have several Blank rows above each is a row of data (covering columns A-D), what I want to do is populate each blank row with the following:-

Col A - Copy the Text from Row Above
Col B - Insert fixed Text "ABC"
Col C - I wish to remain blank
Col D - Copy the value that is in Col C in Row above to this column

Do above until last Row in sheet (as sheet can have a variable length)

Basically above are Debit and Credit lines,

Claus Busch

Copy Row Above, with a Twist Q
 
Hi,

Am Wed, 4 Jan 2017 23:52:19 -0800 (PST) schrieb :

I have several Blank rows above each is a row of data (covering columns A-D), what I want to do is populate each blank row with the following:-

Col A - Copy the Text from Row Above
Col B - Insert fixed Text "ABC"
Col C - I wish to remain blank
Col D - Copy the value that is in Col C in Row above to this column


try:

Sub Test()
Dim LRow As Long
Dim myRng As Range, rngC As Range

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set myRng = .Range("A2:A" & LRow)
For Each rngC In myRng.SpecialCells(xlCellTypeBlanks)
rngC = rngC.Offset(-1, 0)
rngC.Offset(, 1) = "ABC"
rngC.Offset(, 3) = rngC.Offset(-1, 2)
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

[email protected]

Copy Row Above, with a Twist Q
 
Claus, works perfect, one slight update I need,

Re Col D - if Col C is blank i.e. has no value (in the row above), then what the Value is in Col D should be copied to Col C, if Col C is not blank, then your original code

As mentioned, these are Debit & Credits, so in first post I assumed all my data rows were debits i.e. had a value in Col C


Claus Busch

Copy Row Above, with a Twist Q
 
Hi,

Am Thu, 5 Jan 2017 00:35:56 -0800 (PST) schrieb :

Re Col D - if Col C is blank i.e. has no value (in the row above), then what the Value is in Col D should be copied to Col C, if Col C is not blank, then your original code


I hope I understood your problem.
Try:

Sub Test()
Dim LRow As Long
Dim myRng As Range, rngC As Range

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set myRng = .Range("A2:A" & LRow)
For Each rngC In myRng.SpecialCells(xlCellTypeBlanks)
rngC = rngC.Offset(-1, 0)
rngC.Offset(, 1) = "ABC"
If Len(rngC.Offset(-1, 2)) = 0 Then
rngC.Offset(, 2) = rngC.Offset(-1, 3)
Else
rngC.Offset(, 3) = rngC.Offset(-1, 2)
End If
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

[email protected]

Copy Row Above, with a Twist Q
 
Claus, thats it, works exactly how I want, one small thing, the very last row of Data doesn't copy down, so the code stops at the last row, but that last row needs to be copied down, then stop

I'm assuming this line needs adjustment LRow = .Cells(.Rows.Count, 1).End(xlUp).Row?


Claus Busch

Copy Row Above, with a Twist Q
 
Hi,

Am Thu, 5 Jan 2017 01:04:02 -0800 (PST) schrieb :

Claus, thats it, works exactly how I want, one small thing, the very last row of Data doesn't copy down, so the code stops at the last row, but that last row needs to be copied down, then stop


change that row
Set myRng = .Range("A2:A" & LRow)
to
Set myRng = .Range("A2:A" & LRow + 1)

Regards
Claus B.
--
Windows10
Office 2016

[email protected]

Copy Row Above, with a Twist Q
 
Claus, that didn't do anything, still last row hasn't copied


Claus Busch

Copy Row Above, with a Twist Q
 
Hi,

Am Thu, 5 Jan 2017 01:14:50 -0800 (PST) schrieb :

Claus, that didn't do anything, still last row hasn't copied


try:

Sub Test()
Dim LRow As Long
Dim myRng As Range, rngC As Range

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Set myRng = .Range("A2:A" & LRow)
myRng.Select
For Each rngC In myRng
If Len(rngC) = 0 Then
rngC = rngC.Offset(-1, 0)
rngC.Offset(, 1) = "ABC"
If Len(rngC.Offset(-1, 2)) = 0 Then
rngC.Offset(, 2) = rngC.Offset(-1, 3)
Else
rngC.Offset(, 3) = rngC.Offset(-1, 2)
End If
End If
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

[email protected]

Copy Row Above, with a Twist Q
 
Bingo Claus, thats it. Many thanks




All times are GMT +1. The time now is 12:34 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com