• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

duplicating a row once or twice dependant on a cell value in another sheet

U

Unexecel

New Member
Hi all

I am having difficulty trying to get the values in a row in sheet 2 to copy down depending on if a value in a cell is > 0

here is thecode I have so far
Code: 
Sub Macro2()
'
' Macro2 Macro
'

'
    Range("A1").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("C1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("E1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("I1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("M1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("U2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("V2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Application.Goto (ActiveWorkbook.Sheets("Sheet1").Range("N1"))
    If N1 > 0 Then
    Sheets("Sheet2").Select
    Range("A2:G2").Select
    Selection.Copy
    Range("A3:G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If

End Sub

I have attached the sheet for you to see my progress, it does the first part ok but fails to copy the row down in sheet 2
 

Attachments

  • Book2.xlsx
    20.6 KB · Views: 4
Last edited by a moderator:
You were referring to the N1 incorrectly, VB thought you were trying to make a variable called "N1". Here's the corrected code, with some clean-up.
Code: 
Sub Macro2()
'
' Macro2 Macro
'
Application.ScreenUpdating = False
Worksheets("Sheet2").Select
With Worksheets("Sheet1")
    'Lines starting with "." refer to the With worksheet
    'other lines refer to the active sheet
    .Range("A1").Copy
    Range("B2").PasteSpecial Paste:=xlPasteValues
   
   
    .Range("C1").Copy
    Range("F2").PasteSpecial Paste:=xlPasteValues
   
    .Range("E1").Copy
    Range("A2").PasteSpecial Paste:=xlPasteValues
   
    .Range("I1").Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues
   
    .Range("M1").Copy
    Range("R2,U2,V2").PasteSpecial Paste:=xlPasteValues
   
    If .Range("N1").Value > 0 Then
        Range("A2:G2").Copy
        Range("A3:G3").PasteSpecial Paste:=xlPasteValues
    End If
   
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
…and a bit more clean-up since all that copying is values only:
Code: 
Sub Macro2()
Application.ScreenUpdating = False
Worksheets("Sheet2").Select
With Worksheets("Sheet1")
  'ranges starting with "." refer to the With worksheet
  'other ranges refer to the active sheet
   Range("B2").Value = .Range("A1").Value
  Range("F2").Value = .Range("C1").Value
  Range("A2").Value = .Range("E1").Value
  Range("G2").Value = .Range("I1").Value
  Range("R2,U2,V2").Value = .Range("M1").Value
  If .Range("N1").Value > 0 Then Range("A3:G3").Value = Range("A2:G2").Value
End With
Application.ScreenUpdating = True
End Sub
 
p45cal said:
…and a bit more clean-up since all that copying is values only:
Code: 
Sub Macro2()
Application.ScreenUpdating = False
Worksheets("Sheet2").Select
With Worksheets("Sheet1")
  'ranges starting with "." refer to the With worksheet
  'other ranges refer to the active sheet
   Range("B2").Value = .Range("A1").Value
  Range("F2").Value = .Range("C1").Value
  Range("A2").Value = .Range("E1").Value
  Range("G2").Value = .Range("I1").Value
  Range("R2,U2,V2").Value = .Range("M1").Value
  If .Range("N1").Value > 0 Then Range("A3:G3").Value = Range("A2:G2").Value
End With
Application.ScreenUpdating = True
End Sub
Click to expand...



Hey Firstly thank you both for helping me not only with a solution but also to begin to understand this problem.

How would i go about getting this to repeat for entire N1 column? would this be to do with arranging a loop?

Thanks again
 
We can first define how many rows to look at, then loop through those rows. When incrementing row number, I find it easier to use the Cells object rather than Range, as it uses 2 arguments, a row number and col reference.
Code: 
Sub Macro2()
Dim lastRow As Long, i As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
With Worksheets("Sheet1")
  'Where is the last cell in col N
  lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
 'other ranges refer to the active sheet
  For i = 1 To lastRow
    Cells(i + 1, "B").Value = .Cells(i, "A").Value
    Cells(i + 1, "F").Value = .Cells(i, "C").Value
    Cells(i + 1, "A").Value = .Cells(i, "E").Value
    Cells(i + 1, "G").Value = .Cells(i, "I").Value
    Cells(i + 1, "R").Value = .Cells(i, "M").Value
    Cells(i + 1, "U").Value = .Cells(i, "M").Value
    Cells(i + 1, "V").Value = .Cells(i, "M").Value
    If .Cells(i, "N").Value > 0 Then Range("A" & i + 2 & ":G" & i + 2).Value = _
      Range("A" & i + 1 & ":G" & i + 1).Value
  Next i
End With
Application.ScreenUpdating = True
End Sub
 
Thank you for this, so would I simply add the below code to integrate the >0 rule you halped make earlier?

If .Range("N1").Value > 0 Then Range("A3:G3").Value = Range("A2:G2").Value
 
Unexecel said:
Thank you for this, so would I simply add the below code to integrate the >0 rule you halped make earlier?

If .Range("N1").Value > 0 Then Range("A3:G3").Value = Range("A2:G2").Value
Click to expand...
Is this a one time check, or should it be done for every loop? If a one time, then it should be outside the loop, but you can write it as you have now. If it needs to moe based on the loop, then you should use the line I put
Code: 
If .Cells(i, "N").Value > 0 Then Range("A" & i + 2 & ":G" & i + 2).Value = _
      Range("A" & i + 1 & ":G" & i + 1).Value

In this line, we're checking some cell in col N, and then copying values from A:G (at row i+1) to the row below (at i+2).
 
Luke M said:
Is this a one time check, or should it be done for every loop? If a one time, then it should be outside the loop, but you can write it as you have now. If it needs to moe based on the loop, then you should use the line I put
Code: 
If .Cells(i, "N").Value > 0 Then Range("A" & i + 2 & ":G" & i + 2).Value = _
      Range("A" & i + 1 & ":G" & i + 1).Value

In this line, we're checking some cell in col N, and then copying values from A:G (at row i+1) to the row below (at i+2).
Click to expand...


Hey thanks for this, this check (n>0) need to be done for every line, My ultimate goal is if:

N>0 then copy Range a2:g2 and replace the (r2,u2,v2) values with the n value from sheet

I hope this makes sense?

Thanks
 
Can you give some example at different rows, to make sure I understand?
I.e., if we've just finished copying data from Sheet1, row 3 to Sheet2, row 4, which cell in col N are we looking at, and which ranges are we copying from/to?
 
Hi

I have uploaded an example with 3 different types of results i am looking to incorporate into sheet 1

they are color coded

let meknow if It is not coming across as clear and I will provide more detail
 

Attachments

  • Help sheet.xlsx
    45.9 KB · Views: 2
so it would "sheet 1" row1 copied to "sheet2" row 2 , as "sheet 1" row 2 cell "n1">0 then "sheet2" row 2 range a2:g2 would be copied below to "sheet2" row 3 however the value of cells "sheet 2" "R3,U3,V3" would be equal to "sheet 1" N1
Then Would copy sheet1 row 2 to sheet2 row4 and if n1> 0 .....
 
Hmm. I think this is closer then. I'm not sure what you meant by R3,U3,V3 being equal to N1. We were not doing any transfering before with N1. Is this a new requirement?
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet")
  'Where is the last cell in col N
 lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
 For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
   
    If .Cells(i, "N").Value > 0 Then
        Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
        Range("A" & recRow & ":G" & recRow).Value
        'Add an extra count to our counter
        recRow = recRow + 1
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
 
Luke M said:
Hmm. I think this is closer then. I'm not sure what you meant by R3,U3,V3 being equal to N1. We were not doing any transfering before with N1. Is this a new requirement?
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet")
  'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
  
    If .Cells(i, "N").Value > 0 Then
        Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
        Range("A" & recRow & ":G" & recRow).Value
        'Add an extra count to our counter
        recRow = recRow + 1
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
Click to expand...



Blimey you are amazing dude!!!!!!!!!!!!

:)

yes for the duplicated row the value would derive from n column rather then m column

so for example :

Transaction Type Supplier Code Reference Date Description Net Amount VAT Code VAT Amount Gross Amount Unallocated Amount Analysis Code Project Code Cost Centre Detail Notes Internal Reference Year Period Batch Reference
INV ACE02 147521 24-Apr-14 507.31 507.31 507.31
INV ACE02 147521 24-Apr-14 101.45 101.45 101.45
 
Ok, so we had 3 more lines into the If statement.
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet")
  'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
    If .Cells(i, "N").Value > 0 Then
        Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
        Range("A" & recRow & ":G" & recRow).Value
        'Copy from N instead of M
        Cells(recRow + 1, "R").Value = .Cells(i, "N").Value
        Cells(recRow + 1, "U").Value = .Cells(i, "N").Value
        Cells(recRow + 1, "V").Value = .Cells(i, "N").Value
       
        'Add an extra count to our counter
       recRow = recRow + 1
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
 
Luke M said:
Ok, so we had 3 more lines into the If statement.
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet")
  'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
    If .Cells(i, "N").Value > 0 Then
        Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
        Range("A" & recRow & ":G" & recRow).Value
        'Copy from N instead of M
        Cells(recRow + 1, "R").Value = .Cells(i, "N").Value
        Cells(recRow + 1, "U").Value = .Cells(i, "N").Value
        Cells(recRow + 1, "V").Value = .Cells(i, "N").Value
      
        'Add an extra count to our counter
       recRow = recRow + 1
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
Click to expand...


I cant actually believe you have managed to do this :)

Thank you soo much.

I was wondering if i could ask you some more questions please?

Would it be possible to add more permutations to the IF statement?

for example if n = 20% of m then add another line (just like if n> 0) populating the first line with m values and the second line with n values (just like you have done above with n > 0)

and secondly (probably impossibly)

if n is > 0 but does not = 20% of m then add 2 lines populating the first line with (m less the sum of the other 2 lines) , the second line with n values multiplied by 4, the 3rd line with n values.

also do you use visual basics the programme or the excel editor?

how did you become soo good at this?

How do you know how to arrange the terms? is their a particular order?

Thanks again for your help
 
A lot of questions! :) I'll try to answer them all.

Permutations are certainly possible, just need to define them all. When you say 20% of M, is that exactly 20%, or could it be >= 20% * M? At first I thought that every case where N > 0, this criteria would be met, but I see that there are some cases where both M and N are negative.
For this case, our If statement would use a Boolean Or type statement, something like:
Code: 
If .Cells(i, "N").Value > 0 Or .Cells(i,"N") = .Cells(i,"M") * 0.2 Then

the other condition is also possible, again assuming we can properly define it. I'm not sure what "m less the sum of the other 2 lines" means precisely. Are the 2 lines that other lines that we are creating, or lines from source data?

I write all of my VB in the Visual Basic Editor that comes with Excel. :)

I've gotten good by several years of practice, having an inquisitive mind that likes solving new challenges, and a lot of time on forums like this one. It all started when I was a lowly co-op assigned mind-numbing repetitive tasks and I knew there had to be a better way. I started recording macros, seeing what the code looked like, and playing around with it. Over time, I learned more about these magical "objects,functions, methods" and how they interacted. I also enjoy reading various blogs. Some of my favorite:
Chandoo (of course! :awesome:)
PeltierTech (awesome Charting tricks)
Contextures (PivotTable mastery)
DailyDoseOfExcel (some XL tricks, lots of VB)

You can define the terms in any order within VB. By convention, I place them at top of routine, and try to group similar type variables together for easier reading.
 
Luke M said:
A lot of questions! :) I'll try to answer them all.

Permutations are certainly possible, just need to define them all. When you say 20% of M, is that exactly 20%, or could it be >= 20% * M? At first I thought that every case where N > 0, this criteria would be met, but I see that there are some cases where both M and N are negative.
For this case, our If statement would use a Boolean Or type statement, something like:
Code: 
If .Cells(i, "N").Value > 0 Or .Cells(i,"N") = .Cells(i,"M") * 0.2 Then

the other condition is also possible, again assuming we can properly define it. I'm not sure what "m less the sum of the other 2 lines" means precisely. Are the 2 lines that other lines that we are creating, or lines from source data?

I write all of my VB in the Visual Basic Editor that comes with Excel. :)

I've gotten good by several years of practice, having an inquisitive mind that likes solving new challenges, and a lot of time on forums like this one. It all started when I was a lowly co-op assigned mind-numbing repetitive tasks and I knew there had to be a better way. I started recording macros, seeing what the code looked like, and playing around with it. Over time, I learned more about these magical "objects,functions, methods" and how they interacted. I also enjoy reading various blogs. Some of my favorite:
Chandoo (of course! :awesome:)
PeltierTech (awesome Charting tricks)
Contextures (PivotTable mastery)
DailyDoseOfExcel (some XL tricks, lots of VB)

You can define the terms in any order within VB. By convention, I place them at top of routine, and try to group similar type variables together for easier reading.
Click to expand...

Hey thanks for helping me and giving me an insight into yourself :)

It would be exactly 20% when rounded up
It would be from the other lines we are creating (sorry i didnt know how else to phrase it)

Are all of these guys you follow on this website?

Hey I am feeling your early pain too, i am always assigned monotonous tasks and I really want to learn VB to make life a bit more enjoyable at work

I thought you may have been using some amazing kcikbutt programme lol
 
Sorry, should have posted links. I've seen Jon, Debra, and Jeff on here before, but not regularly. They have their own important business(es) to run. :)
Links to their sites:
http://blog.contextures.com/
http://peltiertech.com/WordPress/
http://dailydoseofexcel.com/

How many decimals are we rounding to/comparing to? Looks like 2 decimal places.
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet")
  'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
    If .Cells(i, "N").Value > 0 Then
        'I think both of this is how you want it structured...
        'Compare to 2 decimal places
        If .Cells(i, "N").Value = (CLng(.Cells(i, "M").Value * 0.2 * 100) / 100) Then
            Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
            Range("A" & recRow & ":G" & recRow).Value
            'Copy from N instead of M
            Cells(recRow + 1, "R").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "U").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "V").Value = .Cells(i, "N").Value
           
            'Add an extra count to our counter
            recRow = recRow + 1
        Else
            Cells(recRow + 2, "R").Value = .Cells(i, "N").Value
            Cells(recRow + 2, "U").Value = .Cells(i, "N").Value
            Cells(recRow + 2, "V").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "R").Value = .Cells(i, "N").Value * 4
            Cells(recRow + 1, "U").Value = .Cells(i, "N").Value * 4
            Cells(recRow + 1, "V").Value = .Cells(i, "N").Value * 4
            'Sum of other 2 lines is equal to N * 5
            Cells(recRow, "R").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            Cells(recRow, "U").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            Cells(recRow, "V").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
        End If
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
 
Luke M said:
Sorry, should have posted links. I've seen Jon, Debra, and Jeff on here before, but not regularly. They have their own important business(es) to run. :)
Links to their sites:
http://blog.contextures.com/
http://peltiertech.com/WordPress/
http://dailydoseofexcel.com/

How many decimals are we rounding to/comparing to? Looks like 2 decimal places.
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet")
  'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
    If .Cells(i, "N").Value > 0 Then
        'I think both of this is how you want it structured...
        'Compare to 2 decimal places
        If .Cells(i, "N").Value = (CLng(.Cells(i, "M").Value * 0.2 * 100) / 100) Then
            Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
            Range("A" & recRow & ":G" & recRow).Value
            'Copy from N instead of M
            Cells(recRow + 1, "R").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "U").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "V").Value = .Cells(i, "N").Value
         
            'Add an extra count to our counter
            recRow = recRow + 1
        Else
            Cells(recRow + 2, "R").Value = .Cells(i, "N").Value
            Cells(recRow + 2, "U").Value = .Cells(i, "N").Value
            Cells(recRow + 2, "V").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "R").Value = .Cells(i, "N").Value * 4
            Cells(recRow + 1, "U").Value = .Cells(i, "N").Value * 4
            Cells(recRow + 1, "V").Value = .Cells(i, "N").Value * 4
            'Sum of other 2 lines is equal to N * 5
            Cells(recRow, "R").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            Cells(recRow, "U").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            Cells(recRow, "V").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
        End If
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
Click to expand...


Hey Luke

Thanks again for your help honestly it is very much appreciated, I have tried my best to resolve some of the bugs i have come across as I am getting a bit embarrassed for keep having to ask for more help as you are probably busy.

However I am stuck :(

When i run the macros the first line of the data in sheet returns a value of 0.4?

The rule of 20% seems to be working fine

However the last rule does not generate the additional lines

see attached (yellow highlighted for example)

Thanks again
 
The first line is related to overall problem. Macro was overwriting data as it went due to me forgetting to increment counter in the Else part of If statement. See below for correction.
Code: 
Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet3").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet1")
  'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


  'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
    Cells(recRow, "B").Value = .Cells(i, "A").Value
    Cells(recRow, "F").Value = .Cells(i, "C").Value
    Cells(recRow, "A").Value = .Cells(i, "E").Value
    Cells(recRow, "G").Value = .Cells(i, "I").Value
    Cells(recRow, "R").Value = .Cells(i, "M").Value
    Cells(recRow, "U").Value = .Cells(i, "M").Value
    Cells(recRow, "V").Value = .Cells(i, "M").Value
    If .Cells(i, "N").Value > 0 Then
        'I think both of this is how you want it structured...
       'Compare to 2 decimal places
       If .Cells(i, "N").Value = (CLng(.Cells(i, "M").Value * 0.2 * 100) / 100) Then
            Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
            Range("A" & recRow & ":G" & recRow).Value
            'Copy from N instead of M
           Cells(recRow + 1, "R").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "U").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "V").Value = .Cells(i, "N").Value
           
            'Add an extra count to our counter
           recRow = recRow + 1
        Else
            Cells(recRow + 2, "R").Value = .Cells(i, "N").Value
            Cells(recRow + 2, "U").Value = .Cells(i, "N").Value
            Cells(recRow + 2, "V").Value = .Cells(i, "N").Value
            Cells(recRow + 1, "R").Value = .Cells(i, "N").Value * 4
            Cells(recRow + 1, "U").Value = .Cells(i, "N").Value * 4
            Cells(recRow + 1, "V").Value = .Cells(i, "N").Value * 4
            'Sum of other 2 lines is equal to N * 5
           Cells(recRow, "R").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            Cells(recRow, "U").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            Cells(recRow, "V").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
            'EDIT: I forgot to increment the counter so we don't overwrite our data
            recRow = recRow + 2
        End If
    End If
    recRow = recRow + 1
  Next i
End With
Application.ScreenUpdating = True
End Sub
 
You are amazing dude!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

:)

I have amended the code slightly to include population of some blank lines, but i think i have messed it up as I keep getting the 0.4 on the first line?...the rest is perfect though i think?

Sub TransferRecords()
Dim lastRow As Long, i As Long, recRow As Long

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
'Begin output of records
recRow = 2

With Worksheets("Sheet1")
'Where is the last cell in col N
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row


'ranges starting with "." refer to the With worksheet
'other ranges refer to the active sheet
For i = 1 To lastRow
Cells(recRow, "B").Value = .Cells(i, "A").Value
Cells(recRow, "F").Value = .Cells(i, "C").Value
Cells(recRow, "A").Value = .Cells(i, "E").Value
Cells(recRow, "G").Value = .Cells(i, "I").Value
Cells(recRow, "R").Value = .Cells(i, "M").Value
Cells(recRow, "U").Value = .Cells(i, "M").Value
Cells(recRow, "V").Value = .Cells(i, "M").Value
If .Cells(i, "N").Value > 0 Then
'I think both of this is how you want it structured...
'Compare to 2 decimal places
If .Cells(i, "N").Value = (CLng(.Cells(i, "M").Value * 0.2 * 100) / 100) Then
Range("A" & recRow + 1 & ":G" & recRow + 1).Value = _
Range("A" & recRow & ":G" & recRow).Value
'Copy from N instead of M
Cells(recRow + 1, "R").Value = .Cells(i, "N").Value
Cells(recRow + 1, "U").Value = .Cells(i, "N").Value
Cells(recRow + 1, "V").Value = .Cells(i, "N").Value

'Add an extra count to our counter
recRow = recRow + 1
Else

Cells(recRow + 2, "B").Value = .Cells(i, "A").Value
Cells(recRow + 2, "F").Value = .Cells(i, "C").Value
Cells(recRow + 2, "A").Value = .Cells(i, "E").Value
Cells(recRow + 2, "G").Value = .Cells(i, "I").Value
Cells(recRow + 2, "R").Value = .Cells(i, "N").Value
Cells(recRow + 2, "U").Value = .Cells(i, "N").Value
Cells(recRow + 2, "V").Value = .Cells(i, "N").Value

Cells(recRow + 1, "B").Value = .Cells(i, "A").Value
Cells(recRow + 1, "F").Value = .Cells(i, "C").Value
Cells(recRow + 1, "A").Value = .Cells(i, "E").Value
Cells(recRow + 1, "G").Value = .Cells(i, "I").Value
Cells(recRow + 1, "R").Value = .Cells(i, "N").Value * 5
Cells(recRow + 1, "U").Value = .Cells(i, "N").Value * 5
Cells(recRow + 1, "V").Value = .Cells(i, "N").Value * 5
'Sum of other 2 lines is equal to N * 5
Cells(recRow, "R").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
Cells(recRow, "U").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
Cells(recRow, "V").Value = .Cells(i, "M").Value - .Cells(i, "N").Value * 5
'EDIT: I forgot to increment the counter so we don't overwrite our data
recRow = recRow + 2
End If
End If
recRow = recRow + 1
Next i
End With
Application.ScreenUpdating = True
End Sub
 
Hey Thanks for everything I cant believe after this short time and your help I am actually beginning to grasp the fringes of this wonderful amazing thing

...Im not guaranteeing i wont be back to pick your brain though :)
 
You must log in or register to reply here.
Back
Top