VBA Code Example

[DTHMTL]

Could someone possible give me a quick sample code or point me in the right
direction.

I imported a text file.

I want to :

begin loop
if a = true (cell contains a certain value)
copy
paste
skip 3
copy & paste again
else (cell doesn't contain a value)
move onto next row
end if
end loop

Thanks in advance

 

[Mike Tomasura]

Try this.

Private Sub CommandButton1_Click()

x = 1
Do While Range("A" & x) <> ""

'if a = true (cell contains a certain value)
If Range("A" & x) = "yes" Then

' make room for paste
Rows(x + 1 & ":" & x + 1).Select
Selection.Insert Shift:=xlDown
Range("A" & x).Select

' Paste
Range("A" & x + 1) = Range("A" & x)

' Skip 3
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown

' paste again
Range("A" & x + 1) = Range("A" & x)
x = x + 4
End If

x = x + 1
Loop

End Sub


Michael Tomasura

 

[kkknie]

begin loop
if a = true (cell contains a certain value)
copy
paste
skip 3
copy & paste again
else (cell doesn't contain a value)
move onto next row
end if
end loop

I'll make some assumptions for the example:

1. I'm assuming all of your data is in column a and that all rows ar
filled (i.e. no blank spaces in until the last row).
2. Assume you paste one column over and then 3 columns over (1+ski
3).
3. Assume you are looking for the value HELLO.

Here's a go...


Code
-------------------
Sub Testing()

Dim iMax as Long
Dim rng as Range
Dim r as Range

iMax = Range("A65536").End(xlUp).Row

Set rng = Range("A1:A" & iMax)

For Each r in Range
If r.Value = "HELLO"
Cells(r.Row,2).Value = r.Value
Cells(r.Row,5).Value = r.Value
End If
Next

End Su

 

[DTHMTL]

Thanks Tom

Try this.

Private Sub CommandButton1_Click()

x = 1
Do While Range("A" & x) <> ""

'if a = true (cell contains a certain value)
If Range("A" & x) = "yes" Then

' make room for paste
Rows(x + 1 & ":" & x + 1).Select
Selection.Insert Shift:=xlDown
Range("A" & x).Select

' Paste
Range("A" & x + 1) = Range("A" & x)

' Skip 3
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown

' paste again
Range("A" & x + 1) = Range("A" & x)
x = x + 4
End If

x = x + 1
Loop

End Sub


Michael Tomasura

 

[DTHMTL]

Sorry, Thanks Mike.

Try this.

Private Sub CommandButton1_Click()

x = 1
Do While Range("A" & x) <> ""

'if a = true (cell contains a certain value)
If Range("A" & x) = "yes" Then

' make room for paste
Rows(x + 1 & ":" & x + 1).Select
Selection.Insert Shift:=xlDown
Range("A" & x).Select

' Paste
Range("A" & x + 1) = Range("A" & x)

' Skip 3
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown
Rows(x + 1 & ":" & x + 1).Select: Selection.Insert Shift:=xlDown

' paste again
Range("A" & x + 1) = Range("A" & x)
x = x + 4
End If

x = x + 1
Loop

End Sub


Michael Tomasura

 

[DTHMTL]

Thanks. There are a few blank spaces, but I can probably modify your code
to accomodate.