a shorter version of excel macro if cell contain formula

syrum12

New Member
Joined
Dec 9, 2016
Messages
3
Hello first time poster here, I would like to seek help on how can I simplify or shorten the macro formula on excel, the process of the formula is when a data on cell c4 or cell c10 is equals to a specific text, the data will transfer to another specific sheet,

For sample is if “cutting disk 4 dia” is in cell c4 all data in cell c3 to cell c5 will transfer to sheet "3".
And if “flap wheel 6 dia” is in cell c4 all the data in cell c3 to cell c5 will transfer to sheet 2

here is the sample of a formula i copied here in mrexcel, i edited it and it works, but i have more than 100 specific text to input. is there any work around to make the formula simple?

thank you in advance,

Code:
Sub CONSUMABLES1_CLICK()


SHT1RW = Range("Z2")
SHT2RW = Range("Z3")
SHT3RW = Range("Z4")
SHT4RW = Range("Z5")






DATDATI = Range("C3")
ITMNMEI = Range("C4")
QTYQTYI = Range("C5")


DATDATO = Range("C9")
ITMNMEO = Range("C10")
QTYQTYO = Range("C11")




Dim LR As Long, i As Long
    With Sheets("Sheet2")
        LR = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 1 To LR
            With .Range("C" & i)
                If .Value = "FLAP DISK 4 DIA" Then
                    Sheets("1").Select
                    Cells(SHT1RW, 1) = DATDATI
                    Cells(SHT1RW, 2) = ITMNMEI
                    Cells(SHT1RW, 3) = QTYQTYI
                   
                    Cells(SHT1RW, 5) = DATDATO
                    Cells(SHT1RW, 6) = ITEMNMEO
                    Cells(SHT1RW, 7) = QTYQTYO
                    
                    
                    
                  
                ElseIf .Value = "FLAP WHEEL 6 DIA" Then
                    Sheets("2").Select
                    Cells(SHT2RW, 1) = DATDATI
                    Cells(SHT2RW, 2) = ITMNMEI
                    Cells(SHT2RW, 3) = QTYQTYI
                    
                    Cells(SHT2RW, 5) = DATDATO
                    Cells(SHT2RW, 6) = ITEMNMEO
                    Cells(SHT2RW, 7) = QTYQTYO
                    
                    
                    ElseIf .Value = "CUTTING DISK 4 DIA" Then
                    Sheets("3").Select
                    Cells(SHT3RW, 1) = DATDATI
                    Cells(SHT3RW, 2) = ITMNMEI
                    Cells(SHT3RW, 3) = QTYQTYI
                    
                    Cells(SHT3RW, 5) = DATDATO
                    Cells(SHT3RW, 6) = ITEMNMEO
                    Cells(SHT3RW, 7) = QTYQTYO
                    
                    ElseIf .Value = "CUTTING DISK 7 DIA" Then
                    Sheets("4").Select
                    Cells(SHT4RW, 1) = DATDATI
                    Cells(SHT4RW, 2) = ITMNMEI
                    Cells(SHT4RW, 3) = QTYQTYI
                    
                    Cells(SHT4RW, 5) = DATDATO
                    Cells(SHT4RW, 6) = ITEMNMEO
                    Cells(SHT4RW, 7) = QTYQTYO
                   
                
                End If
            End With
        Next i
    End With


Sheets("Sheet2").Select
Range("C3:C35").ClearContents
Range("C5").Select








End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Forum statistics

Threads
1,213,557
Messages
6,114,291
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top