Cut and paste value from fixed cell to a variable cell

Hello,

I am trying to run:

*Cut value from cell A1
*Paste value in column B, only IF column A equals "Drinks"

Rick provided the code below for a similar requirement but would like to edited for th above.

Thanks in advance for your help!

"Dim Amount As Long
Amount = Cells(Rows.Count, "B").End(xlUp).Row
Range("F2:F" & Amount) = Evaluate("IF(B2:B" & Amount & "=""OK"",IN2:IN" & Amount & ",IO2:IO" & Amount & ")")"

This appears to be what you are asking for...

Code:

---

Sub DrinksAnyone()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B1:B" & LastRow) = Evaluate("IF(A1:A" & LastRow & "=""Drinks"",""Drinks"",B1:B" & LastRow & ")")
  Columns("A").ClearContents
End Sub

---

Note: That last line is there because you said you wanted to "*Cut value from cell A1".

Hi Rick,

Thanks for your help.

The code is not working though, I may have explained incorrectly.

*I will always have a variable value in cell A1
*I need to be able to paste that value in column C only IF column B = Drinks.

The problem I am having is that is currently copying "0" and not "100" in this case. I believe its because I had the value in the same column as the delimiter (Drinks). I have moved the delimiter to column B.

Thanks again!

Quote:

---

Originally Posted by Rick Rothstein

This appears to be what you are asking for...

Code:

---

Sub DrinksAnyone()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B1:B" & LastRow) = Evaluate("IF(A1:A" & LastRow & "=""Drinks"",""Drinks"",B1:B" & LastRow & ")")
  Columns("A").ClearContents
End Sub

---

Note: That last line is there because you said you wanted to "*Cut value from cell A1".

---

May be this is what you are looking for

Code:

---

Sub Test()

    Dim rngRange                            As Range
    Dim rngCell                            As Range
    Dim lngCount                            As Long
   
    Const strSearchCriteria                As String = "A"
    Const strDataStartCell                  As String = "A1"
    Const intColNoToFilter                  As Integer = 2
    Const intOutputColumnNo                As Integer = 3
   
    ReDim varData(0)
    With ThisWorkbook.Worksheets("sheet1")
   
        .AutoFilterMode = False
        Set rngRange = .Range(strDataStartCell).CurrentRegion
       
        With rngRange
            .AutoFilter
            .AutoFilter Field:=intColNoToFilter, Criteria1:=strSearchCriteria
        End With
       
        On Error Resume Next
        Set rngRange = rngRange.Resize(, 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0: Err.Clear
       
        lngCount = 0
        For Each rngCell In rngRange
            If lngCount = 1 Then
                rngCell.Offset(, intOutputColumnNo - 1).Value = rngCell.Value
            Else
                lngCount = 1
            End If
        Next rngCell
       
        .AutoFilterMode = False
       
    End With

End Sub

---

You can do it by using formula also

Code:

---

Sub Test2()

    Dim strFormula                          As String
    Dim rngRange                            As Range
   
    Const strSearchCriteria                As String = "A"
    Const strDataStartCell                  As String = "A1"
    Const intColNoToFilter                  As Integer = 2
    Const intOutputColumnNo                As Integer = 3
   
    With ThisWorkbook.Worksheets("Sheet1")
        Set rngRange = .Range(strDataStartCell).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
        Set rngRange = Intersect(rngRange, rngRange.Offset(1))
        strFormula = "=IF(" & rngRange.Offset(, 1).Address(0, 0) & "=""" & strSearchCriteria & """," & rngRange.Address(0, 0) & ","""")"
        rngRange.Offset(, intOutputColumnNo - 1).Value = Evaluate(strFormula)
    End With

End Sub

---

Quote:

---

Originally Posted by Charles_

The code is not working though, I may have explained incorrectly.

*I will always have a variable value in cell A1
*I need to be able to paste that value in column C only IF column B = Drinks.

The problem I am having is that is currently copying "0" and not "100" in this case. I believe its because I had the value in the same column as the delimiter (Drinks). I have moved the delimiter to column B.

---

Now you have changed from cutting values to simply copying them, so I don't know whether the values in Column A (or B for that matter) are supposed to stay or be removed. I have chosen not to remove them. See if this code does what you want...

Code:

---

Sub DrinksAnyone()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & LastRow) = Evaluate("IF(B1:B" & LastRow & "=""Drinks"",""Drinks"",IF(C1:C" & _
                                      LastRow & "="""","""",C1:C" & LastRow & "))")
End Sub

---

Note for future questions or possible follow-ups to this one... a picture is really worth a thousand words. Simply show us a relatively accurate sample of your existing setup (may 10 or so rows) and for that same data show us what you want it to look like afterwards. You can do that by a typed-in set of spaced data or, better yet, attach a sample workbook in which you clearly identify for us what is the existing and what is the final after-processing result. You can still try to explain in words what you want (the extra details you provide may supply valuable additional information), but the "picture" would be so much more useful.

Thank you LalitPandey87,

Could you please mention where should I be inserting the "Drinks" variable in the code below? I dont see where am I telling VBA to copy cell A1 to column F only if B is Drinks.

Sorry, I am quite new to VBA

Thanks!

Quote:

---

Originally Posted by LalitPandey87

You can do it by using formula also

Code:

---

Sub Test2()

    Dim strFormula                          As String
    Dim rngRange                            As Range
   
    Const strSearchCriteria                As String = "A"
    Const strDataStartCell                  As String = "A1"
    Const intColNoToFilter                  As Integer = 2
    Const intOutputColumnNo                As Integer = 3
   
    With ThisWorkbook.Worksheets("Sheet1")
        Set rngRange = .Range(strDataStartCell).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
        Set rngRange = Intersect(rngRange, rngRange.Offset(1))
        strFormula = "=IF(" & rngRange.Offset(, 1).Address(0, 0) & "=""" & strSearchCriteria & """," & rngRange.Address(0, 0) & ","""")"
        rngRange.Offset(, intOutputColumnNo - 1).Value = Evaluate(strFormula)
    End With

End Sub

---

---

Change below line of code

Const strSearchCriteria As String = "A"

with this one

Const strSearchCriteria As String = "Drinks"

Fully Agree with Rick

Quote:

---

Originally Posted by Rick Rothstein

Note for future questions or possible follow-ups to this one... a picture is really worth a thousand words. Simply show us a relatively accurate sample of your existing setup (may 10 or so rows) and for that same data show us what you want it to look like afterwards. You can do that by a typed-in set of spaced data or, better yet, attach a sample workbook in which you clearly identify for us what is the existing and what is the final after-processing result. You can still try to explain in words what you want (the extra details you provide may supply valuable additional information), but the "picture" would be so much more useful.

---

Hi Rick,

Thanks again for your help.

Following your advise, please find below an example of the worksheet attached.

The code is pasting the word "Drinks" in column C rather than the value in cell A1 (100)

Thanks again!!

As per your attached Screenshots following will work:

Code:

---

Sub Test2()

    Dim strFormula                          As String
    Dim rngRange                            As Range
   
    Const strSearchCriteria                As String = "Drinks"
    Const strDataStartCell                  As String = "A1"
    Const intColNoToFilter                  As Integer = 2
    Const intOutputColumnNo                As Integer = 3
   
    With ThisWorkbook.Worksheets("Sheet1")
        Set rngRange = .Range(strDataStartCell).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
        Set rngRange = Intersect(rngRange, rngRange.Offset(1))
        strFormula = "=IF(" & rngRange.Offset(, 1).Address(0, 0) & "=""" & strSearchCriteria & """," & rngRange.Offset(, 1).Address(0, 0) & ","""")"
        rngRange.Offset(, intOutputColumnNo - 1).Value = Evaluate(strFormula)
    End With

End Sub

---

Thanks LalitPandey87!

I am getting Run - time error "Object variable or With block variable not set. It is highlighting the below line in bold.
I know I have to set the variables on that line but not sure where to.

Thanks again for your help!!


Sub Test2()

Dim strFormula As String
Dim rngRange As Range

Const strSearchCriteria As String = "Drinks"
Const strDataStartCell As String = "A1"
Const intColNoToFilter As Integer = 2
Const intOutputColumnNo As Integer = 3

With ThisWorkbook.Worksheets("Sheet1")
Set rngRange = .Range(strDataStartCell).Resize(.Cells(.Rows.Count , 1).End(xlUp).Row, 1)
Set rngRange = Intersect(rngRange, rngRange.Offset(1))
strFormula = "=IF(" & rngRange.Offset(, 1).Address(0, 0) & "=""" & strSearchCriteria & """," & rngRange.Offset(, 1).Address(0, 0) & ","""")"
rngRange.Offset(, intOutputColumnNo - 1).Value = Evaluate(strFormula)
End With

End Sub

Quote:

---

Originally Posted by LalitPandey87

As per your attached Screenshots following will work:

Code:

---

Sub Test2()

    Dim strFormula                          As String
    Dim rngRange                            As Range
   
    Const strSearchCriteria                As String = "Drinks"
    Const strDataStartCell                  As String = "A1"
    Const intColNoToFilter                  As Integer = 2
    Const intOutputColumnNo                As Integer = 3
   
    With ThisWorkbook.Worksheets("Sheet1")
        Set rngRange = .Range(strDataStartCell).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
        Set rngRange = Intersect(rngRange, rngRange.Offset(1))
        strFormula = "=IF(" & rngRange.Offset(, 1).Address(0, 0) & "=""" & strSearchCriteria & """," & rngRange.Offset(, 1).Address(0, 0) & ","""")"
        rngRange.Offset(, intOutputColumnNo - 1).Value = Evaluate(strFormula)
    End With

End Sub

---

---

Quote:

---

Originally Posted by Charles_

Following your advise, please find below an example of the worksheet attached.

The code is pasting the word "Drinks" in column C rather than the value in cell A1 (100)

---

Perfect... now I see what you are describing. Here is the code for the layout you showed in your pictures (but read on afterwards because I sense you actually need a more generic solution than you have asked for)...

Code:

---

Sub SwitchLetters()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range("C2:C" & LastRow) = Evaluate("IF(B2:B" & LastRow & "=""Drinks"",A1,C2:C" & LastRow & ")")
End Sub

---

The description for your original layout makes sense to me now. It also looks like you have a list of "items" that you are filling in prices for. So, let's go back to your originall described layout, but filled in the way I think it looks "at the beginning"... in other words, Column A (Row 2 on down) contain your items and Column B is blank. You then, I am guessing, want to put a word in Row 1 (I'll assume A1) and a price next to it (I'll assume in B1) and then I sense you would want to run code to fill in the number next to each item down the list in Column A that match the item specified in cell A1 using the number from B1. Then I imagine you want to change the value in A1 to a different item, put a different number in B1 and run the macro again having it fill the new number next to each item in Column A matching the item name in A1. I imagine you want to do this for your whole list. If I am right, give this macro a try (remember, your list is in A2 on down and A1 is where you put the item name to look up and B1 is where you put the number to fill next to that item)...

Code:

---

Sub FillInNumbers()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B2:B" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=A1,B1,IF(B2:B" & _
                                    LastRow & "="""","""",B2:B" & LastRow & "))")
End Sub

---

This is how I imagine things (see the tab names for explanations)...

But i didn't find any error. Working on my system. :(

Hello Rick & LalitPandey87 ,

Thanks again for your persistance!

Rick, sorry for not providing the screenshots before as the code would have been much easier to troubleshoot and resolve, leasson learnt! Regarding the above, the first macros worked perfectly, the second one did not.

Basically, this is the very last step of the macros I am running and the total for "Drinks" I've calculated using a code to filter and sum all "beverages" and "alcohol" and copying in cell A1. I then had to delete all rows with "beverages" and "alcohol" , add a line at the end of the file with "Drinks" in Column B and pull the value from cell A1 into Column C.

I can't thank you enough for your dedication, I hope one day I can help somone in the same way.

Quote:

---

Originally Posted by Rick Rothstein

Perfect... now I see what you are describing. Here is the code for the layout you showed in your pictures (but read on afterwards because I sense you actually need a more generic solution than you have asked for)...

Code:

---

Sub SwitchLetters()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range("C2:C" & LastRow) = Evaluate("IF(B2:B" & LastRow & "=""Drinks"",A1,C2:C" & LastRow & ")")
End Sub

---

The description for your original layout makes sense to me now. It also looks like you have a list of "items" that you are filling in prices for. So, let's go back to your originall described layout, but filled in the way I think it looks "at the beginning"... in other words, Column A (Row 2 on down) contain your items and Column B is blank. You then, I am guessing, want to put a word in Row 1 (I'll assume A1) and a price next to it (I'll assume in B1) and then I sense you would want to run code to fill in the number next to each item down the list in Column A that match the item specified in cell A1 using the number from B1. Then I imagine you want to change the value in A1 to a different item, put a different number in B1 and run the macro again having it fill the new number next to each item in Column A matching the item name in A1. I imagine you want to do this for your whole list. If I am right, give this macro a try (remember, your list is in A2 on down and A1 is where you put the item name to look up and B1 is where you put the number to fill next to that item)...

Code:

---

Sub FillInNumbers()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B2:B" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=A1,B1,IF(B2:B" & _
                                    LastRow & "="""","""",B2:B" & LastRow & "))")
End Sub

---

This is how I imagine things (see the tab names for explanations)...

---

Quote:

---

Originally Posted by Charles_

Rick, sorry for not providing the screenshots before as the code would have been much easier to troubleshoot and resolve, leasson learnt! Regarding the above, the first macros worked perfectly, the second one did not.

Basically, this is the very last step of the macros I am running and the total for "Drinks" I've calculated using a code to filter and sum all "beverages" and "alcohol" and copying in cell A1. I then had to delete all rows with "beverages" and "alcohol" , add a line at the end of the file with "Drinks" in Column B and pull the value from cell A1 into Column C.

I can't thank you enough for your dedication, I hope one day I can help somone in the same way.

---

First off, you are quite welcome... I was glad I was able to be of some help. As for the picture... as soon as I saw it, I knew exactly what you wanted (your written description was still useful... I used both of them to figure out what was needed), so I knew my first macro would work. As for the second macro... that was just a guess at what it looked like you were doing... I guessed wrong... it happens (way too much, unfortunately:().