Matching values from column C to D and cut pasting to column G

[Mgmarm]

Hi Guys I am new to the forum

I am new to vba and I am trying to code a bit of automation..
What I am trying to accomplish is matching the time to the specific code "A207"
and cutting the value and pasting it to another column..

here is what I got

Dim rng As Range
Dim rngFound As Range
Dim cellNumber As Integer


Set rng = Range("C:C")
Set rngFound = rng.Find("A207")
cellNumber = 1

Do While cellNumber < 500
cellNumber = cellNumber + 1
If Range("D" & cellNumber) = rngFound Then
Selection.Cut
Range("G" & cellNumber).Paste


Else
End If

Loop






Thanks,

M

 

[jasonb75]

Among other things, your method of Set rngfound As Range will only ever find the first instance as it's outside of the loop.

How about

Option Explicit
Sub test()
Dim c As Range
For Each c In Intersect("C:C", Activesheet.Usedrange))
    If c.Value = "A207" Then 
        c.Offset(0, 4) = c.Offset(0, 1)
        c.Offset(0, 1).ClearContents
    End If
Next
End Sub

This will move the value from column D to column G when column C = A207. Is this what you're trying to do? The ranges in your code don't clearly explain what you need.

 

[Mgmarm]

Hi Guys I am new to the forum

I am new to vba and I am trying to code a bit of automation..
What I am trying to accomplish is matching the time to the specific code "A207"
and cutting the value and pasting it to another column..

here is what I got

Dim rng As Range
Dim rngFound As Range
Dim cellNumber As Integer


Set rng = Range("C:C")
Set rngFound = rng.Find("A207")
cellNumber = 1

Do While cellNumber < 500
cellNumber = cellNumber + 1
If Range("D" & cellNumber) = rngFound Then
Selection.Cut
Range("G" & cellNumber).Paste


Else
End If

Loop






Thanks,

M

Issue Resolved Thanks Guys


Dim rng As Range
Dim rngFound As Range
Dim cellNumber As Integer


Set rng = Range("C:C")
Set rngFound = rng.Find("A207")
cellNumber = 1

Do While cellNumber < 500
cellNumber = cellNumber + 1
If Range("C" & cellNumber) = rngFound Then
Range("D" & cellNumber).Select
Selection.Cut
Range("G" & cellNumber).Select
ActiveSheet.Paste


End If



Loop

 

[Mgmarm]

Thanks for the reply Jason your method looks a lot more efficient but I am having problems with this line

For Each c In Intersect("C:C", Activesheet.usedRange))

I think its the usedrange part sorry I know I look like a total newbie :S

Thanks Again!

M

Among other things, your method of Set rngfound As Range will only ever find the first instance as it's outside of the loop.

How about

Option Explicit
Sub test()
Dim c As Range
For Each c In Intersect("C:C", Activesheet.Usedrange))
    If c.Value = "A207" Then 
        c.Offset(0, 4) = c.Offset(0, 1)
        c.Offset(0, 1).ClearContents
    End If
Next
End Sub

This will move the value from column D to column G when column C = A207. Is this what you're trying to do? The ranges in your code don't clearly explain what you need.

 

[jasonb75]

There's nothing wrong with being a newbie, everyone has to start somewhere.

There was a typo in the code, fixed now

Option Explicit
Sub test()
Dim c As Range
For Each c In Intersect(Range("C:C"), ActiveSheet.UsedRange)
    If c.Value = "A207" Then
        c.Offset(0, 4) = c.Offset(0, 1)
        c.Offset(0, 1).ClearContents
    End If
Next
End Sub

 

[Mgmarm]

Thanks Again!

Code looks great
If I wanted to make a list of values could i just make an Array and feed it to Value

Dim c As Range
Dim Meet As Variant


Meet = Array("A207", "A240", "A224", "A225")


For Each c In Intersect(Range("C:C"), ActiveSheet.UsedRange)
If c.Value = Meet Then
c.Offset(0, 4) = c.Offset(0, 1)
c.Offset(0, 1).ClearContents
End If
Next

 

[jasonb75]

You could, but you would need to loop through the array

Option Explicit
Sub test()
Dim c As Range, meet As Variant, mcount As Long
    
    meet = Array("A207", "A240", "A224", "A225")

For Each c In Intersect(Range("C:C"), ActiveSheet.UsedRange)
    For mcount = LBound(meet) To UBound(meet)
        If c.Value = meet(mcount) Then
            c.Offset(0, 4) = c.Offset(0, 1)
            c.Offset(0, 1).ClearContents
            Exit For
        End If
    Next
Next
End Sub

 

[Mgmarm]

Thanks again Jason!

I am going to break down the code and learn it

 

[jasonb75]

You're welcome,

I'm going to add a bit more to it for you to break down and learn, this is one of the simplest, yet most effective ways of making code run faster.

Option Explicit
Sub test()
Dim c As Range, meet As Variant, mcount As Long
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    
    meet = Array("A207", "A240", "A224", "A225")

For Each c In Intersect(Range("C:C"), ActiveSheet.UsedRange)
    For mcount = LBound(meet) To UBound(meet)
        If c.Value = meet(mcount) Then
            c.Offset(0, 4) = c.Offset(0, 1)
            c.Offset(0, 1).ClearContents
            Exit For
        End If
    Next
Next
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub