-1

I'm working on simplifying an excel worksheet and I want information in the rows to be transferred based on the value. If the value = "done", I want it transferred to Carc. If the value = "On-going", I want it transferred to Ccon (haven't typed this up yet). This have been written-up in VBA but I'm open to trying other things if it would make things easier.

Main thing is that I'm trying to find a way to make the code already made, simpler and more practical. Only thing I haven't figured out is how to have it select 1 individual row, instead of all rows.

Sub MoveBasedOnValue2()

Dim TakeCell As Range
Dim DestCell As Range

Dim Status As Range
Dim Cjob As Worksheet
Dim CArc As Worksheet

Dim Contact As Range, Subject As Range, JobNo As Range, QuoteNo As Range
Dim Dateofcommision As Range, Ddate As Range

Set Cjob = Sheet4
Set CArc = Sheet1


If Cjob.Range("G2") = "Done" Then

Set Contact = Cjob.Range("A2")
Set Subject = Cjob.Range("B2")
Set QuoteNo = Cjob.Range("C2")
Set JobNo = Cjob.Range("D2")
Set Dateofcommision = Cjob.Range("E2")
Set Ddate = Cjob.Range("F2")

Status.Select
Contact.Select
Subject.Select
QuoteNo.Select
JobNo.Select
Dateofcommision.Select
Ddate.Select

If CArc.Range("A2") = "" Then
    Set DestCell = CArc.Range("A2")
Else
    Set DestCell = CArc.Range("A1").End(xlDown).Offset(1, 0)
End If

Contact.Copy DestCell
Subject.Copy DestCell.Offset(0, 1)
QuoteNo.Copy DestCell.Offset(0, 2)
JobNo.Copy DestCell.Offset(0, 3)
Dateofcommision.Copy DestCell.Offset(0, 4)
Ddate.Copy DestCell.Offset(0, 5)

Status.ClearContents
Contact.ClearContents
Subject.ClearContents
QuoteNo.ClearContents
JobNo.ClearContents
Dateofcommision.ClearContents
Ddate.ClearContents
End If
  • 1
    Welcome to SO. I think you should add input and expected output. Sounds like you may benefit from Select Case and from Range objects – Foxfire And Burns And Burns Jan 19 '23 at 14:10
  • 1
    Also reading [How to avoid using select](https://stackoverflow.com/a/23913882/16578424) and [How to avoid copy/paste](https://stackoverflow.com/a/64611707/16578424) might help you. – Ike Jan 19 '23 at 14:33
  • All that has been posted is a program description, but that doesn't tell us what _problem_ you're having. What have you tried, and what troubles did you encounter? Please [edit] your post to include a [valid question](/help/how-to-ask) that we can answer. Reminder: make sure you know what is [on-topic](/help/on-topic); asking us to write the program for you, opinions, and external links are off-topic. – Jim G. Jan 20 '23 at 18:48
  • You seem to have posted more code than what would be reasonable for your issue. Please read [ask] and how to make a [mre]; providing a MRE helps users answer your question and future users relate to your issue. – Jim G. Jan 20 '23 at 18:48

1 Answers1

0

You can do something like this:

Sub MoveBasedOnValue2()

    Dim cStatus As Range, wsDest As Worksheet
    
    Set cStatus = Sheet4.Range("G2") 'first cell to check status
    
    Do While Len(cStatus.Value) > 0
        Select Case LCase(cStatus.Value)
            Case "done": Set wsDest = Sheet1
            Case "on-going": Set wsDest = Sheet2 'for example
            Case Else: Set wsDest = Nothing      'no move to make
        End Select
        
        If Not wsDest Is Nothing Then 'got a destination sheet?
            'here Range("A1:F2") is *relative* to the whole row...
            cStatus.EntireRow.Range("A1:F2").Cut _
               Destination:=wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        
        Set cStatus = cStatus.Offset(1, 0) 'next source row
    Loop
End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125