problem in applying formula by VBA

SG · Jun 30, 2014

Hi Experts,

really need ur help on macro. I have two problems .Please check my macro & help me with solutions for below problems.
I have attached the sheet for your reference:-

1.while applying formula in the column, it selects the last cell number of column like "Range("S3959").Select"
whereas i need that it should read itself the last cell in the column & appluy formula because the range of data would change.

2. I want to apply formula on filtered blank cells. i have tried it by last two lines of my code but it won't work.

Please help me with the right code.

SG · Jun 30, 2014

hi all,

please help me with a solution.

Deepak · Jun 30, 2014

Pls Check with it...

Code:

Option Explicit

Sub A_Clean()
Dim lrow As Long, i As Long
With ActiveSheet
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
.[S1:T1] = Array("con", "c")
Union(.Range(.Cells(2, "H"), .Cells(lrow, "H")), _
        .Range(.Cells(2, "S"), .Cells(lrow, "S")), _
        .Range(.Cells(2, "T"), .Cells(lrow, "T"))) = ""

For i = 2 To lrow
    .Cells(i, "S") = .Cells(i, "E") & .Cells(i, "P")
    .Cells(i, "T") = Application.CountIf(.Columns("S"), .Cells(i, "S"))
    On Error Resume Next
    If InStr(.Cells(i, "D"), "%") = InStrRev(.Cells(i, "D"), "%") Then
   
    .Cells(i, "H") = Mid(.Cells(i, "D"), InStr(.Cells(i, "D"), "%") - 2, 3)
    Else
    .Cells(i, "H") = Mid(.Cells(i, "D"), InStr(.Cells(i, "D"), "%") - 2, 3) _
                & "-" & Mid(.Cells(i, "D"), InStrRev(.Cells(i, "D"), "%") - 2, 3)
    End If
    On Error GoTo 0
Next
End With
MsgBox "Done", vbInformation
End Sub

SG · Jul 1, 2014

Hi Deepak,

Thanks for the code but it's really difficult for me to understand it.Also, it's not applying the formula on column H blank cells where the column L should be selected as "discount". Can't something can be done in my code?? is that totally wrong??

Deepak · Jul 1, 2014

Your entire code is not wrong but this works faster rather then your code!!
I did the changes as you want.

let me explain the code!!

Code:

Option Explicit

Sub A_Clean()
'Declare variable
Dim lrow As Long, i As Long

'Insure to work with only active sheet
With ActiveSheet

'Find last row in the active sheet
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row

'Cell Value for S1 & T1
.[S1:T1] = Array("con", "c")

'Clear the column H, S, T
Union(.Range(.Cells(2, "H"), .Cells(lrow, "H")), _
        .Range(.Cells(2, "S"), .Cells(lrow, "S")), _
        .Range(.Cells(2, "T"), .Cells(lrow, "T"))) = ""

'Start the loop
For i = 2 To lrow
    .Cells(i, "S") = .Cells(i, "E") & .Cells(i, "P")
    .Cells(i, "T") = Application.CountIf(.Columns("S"), .Cells(i, "S"))
'Error trap
   On Error Resume Next

   'Check in column L for discount
    If Not .Cells(i, "L") <> "Discount" Then
       If InStr(.Cells(i, "D"), "%") = InStrRev(.Cells(i, "D"), "%") Then
        .Cells(i, "H") = Mid(.Cells(i, "D"), InStr(.Cells(i, "D"), "%") - 2, 3)
       Else
        .Cells(i, "H") = Mid(.Cells(i, "D"), InStr(.Cells(i, "D"), "%") - 2, 3) _
                    & "-" & Mid(.Cells(i, "D"), InStrRev(.Cells(i, "D"), "%") - 2, 3)
       End If
    End If
'End of error
    On Error GoTo 0
Next
End With

'Msgbox on end of the macro.
MsgBox "Done", vbInformation
End Sub

Smallman · Jul 1, 2014

Hi SC

This should be easier for you to follow. It tracks what you were doing originally but does it a bit more directly. For this to work you need to add a sheet to your workbook as I see from your code you are copying to sheet2 so I have replicated that action (there was no sheet2 so you need to add one).

Anyways here is the code.

Code:

Option Explicit

Sub NoLoop()
Dim lr As Long

lr = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.AutoFilterMode = 0
Range("S2:S" & lr) = "=E2&P2"
Range("T2:T" & lr) = "=Countif(S:S,S2)"
Range("T1:T" & lr).AutoFilter 1, 2
Range("A1:R" & lr).Copy Sheet2.[a1]
[T1].AutoFilter

Range("H1:L" & lr).AutoFilter 5, "Discount"
Range("H1:L" & lr).AutoFilter 1, ""

Range("H1:H" & lr) = "Your Formula Goes Here"
[H1].AutoFilter
End Sub

I could not work out the formula which you were trying to apply from H1 so I filled the range with text. The theory works just need a bit more clarity on your formula.

Take care

Smallman

SG · Jul 1, 2014

Hi Deepak,

Thanks for the explanation. Now i'm facing one problem in your code, first it is deleting the already mentioned discount% in column H whereas
the formula needs to be applied on blank cells. my requirement is not to delete the existing discount %. Can you please look for this.

SG · Jul 1, 2014

Hi Smallman,

Thanks so much for the code. i'm facing only one problem when the execution comes to using formula, it throws the error " application defined or object defined
error". I think the way i'm writing the formula may be wrong. my formula extracts the discount% from column D & formula is

Range("H1:H" & lr) = "=IFERROR(MID(RC[-4],FIND(""$"",RC[-4],1),FIND("""RC[-4],FIND(""$"",RC[-4]))-FIND(""$"",RC[-4])),MID(SUBSTITUTE(RC[-4],""%"",""%""),(FIND(""%"",SUBSTITUTE(RC[-4],""%"",""%""))-2),4))"

Can you please look into this because in excel , this formula is working fine.attaching the file for your reference.

Deepak · Jul 1, 2014

SG said:
Hi Deepak,

Thanks for the explanation. Now i'm facing one problem in your code, first it is deleting the already mentioned discount% in column H whereas
the formula needs to be applied on blank cells. my requirement is not to delete the existing discount %. Can you please look for this.

Pls check!!

Code:

Sub A_Clean()
'Declare variable
Dim lrow As Long, i As Long

'Insure to work with only active sheet
With ActiveSheet

'Find last row in the active sheet
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row

'Cell Value for S1 & T1
.[S1:T1] = Array("con", "c")

'Clear the column H, S, T
Union(.Range(.Cells(2, "S"), .Cells(lrow, "S")), _
        .Range(.Cells(2, "T"), .Cells(lrow, "T"))) = ""

'Start the loop
For i = 2 To lrow
    .Cells(i, "S").Value = .Cells(i, "E") & .Cells(i, "P")
    .Cells(i, "T").Value = Application.CountIf(.Columns("S"), .Cells(i, "S"))
'Error trap
  On Error Resume Next

   'Check in column L for discount and non blanks
   If Not .Cells(i, "L").Value <> "Discount" And Not Len(.Cells(i, "H").Value) <> 0 Then
       If InStr(.Cells(i, "D").Value, "%") = InStrRev(.Cells(i, "D").Value, "%") Then
        .Cells(i, "H").Value = Mid(.Cells(i, "D").Value, InStr(.Cells(i, "D").Value, "%") - 2, 3)
       Else
        .Cells(i, "H").Value = Mid(.Cells(i, "D").Value, InStr(.Cells(i, "D").Value, "%") - 2, 3) _
                    & "-" & Mid(.Cells(i, "D").Value, InStrRev(.Cells(i, "D").Value, "%") - 2, 3)
       End If
    End If
'End of error
   On Error GoTo 0
Next
End With

'Msgbox on end of the macro.
MsgBox "Done", vbInformation
End Sub

SG · Jul 1, 2014

attachment smallman

SG · Jul 1, 2014

Hi Deepak,

attaching file for your reference. I have highlighted some cells as orange. It's not filling up the cells by formula.

Deepak · Jul 1, 2014

SG said:
Hi Deepak,

attaching file for your reference. I have highlighted some cells as orange. It's not filling up the cells by formula.

What values you want there.

SG · Jul 1, 2014

Deepak, if u check my initial code...i have written a formula which will extract the discount% from column D & update it in column H.
For your reference the formula to be update in column h is

=IFERROR(MID(d3,FIND("$",d3,1),FIND(" ",d3,FIND("$",d3))-FIND("$",d3)),MID(SUBSTITUTE(d3," %","%"),(FIND("%",SUBSTITUTE(d3," %","%"))-2),4))

Smallman · Jul 2, 2014

Hi SG

Thanks for providing the Excel formula. Here is the code I will provide a file to prove workings.

Code:

Option Explicit
 
Sub NoLoop2()
Dim lr As Long
Dim rw As Long
 
lr = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.AutoFilterMode = 0
Range("S2:S" & lr) = "=E2&P2"
Range("T2:T" & lr) = "=Countif(S:S,S2)"
Range("U2:U" & lr) = "=IFERROR(MID(D2,FIND(""$"",D2,1),FIND("" "",D2,FIND(""$"",D2))-FIND(""$"",D2)),MID(SUBSTITUTE(D2,"" %"",""%""),(FIND(""%"",SUBSTITUTE(D2,"" %"",""%""))-2),4))"
Range("T1:T" & lr).AutoFilter 1, 2
Range("A1:R" & lr).Copy Sheet3.[a1]
[T1].AutoFilter
 
Range("H1:L" & lr).AutoFilter 5, "Discount"
Range("H1:L" & lr).AutoFilter 1, ""
 
rw = Range("l2", Cells(Rows.Count, "l").End(xlUp)).SpecialCells(12).Cells(1, 1).Row
Range("h" & rw & ":H" & lr) = "=RC[13]"
[H1].AutoFilter
End Sub

The above should get you over the line. Performs only a few actions to complete the task.

Take care

Smallman

SG · Jul 2, 2014

Hi Smallman,

really thanks for ur help & time on this. Just for the understanding, why the formula wasn't working under this codeline
"Range("H1:H" & lr) = "Your Formula Goes Here"".

Smallman · Jul 2, 2014

Hi SG

No worries at all. The code looks like it will not work because you have the whole thing in quotation marks. It is partly a quote and partly code saying where to put the quote so this would work.

Range("H1:H" & lr) = "Your Formula Goes Here"

Where you had assigned the last row (lr) a row number.

Hope this helps

Take Care

Smallman

SG · Jul 3, 2014

Smallman, thanks for the explanation. One last question because i haven't seen such declaration till now....in below codeline what does Range("l2", Cells(Rows.Count, "l") means...may be this is
a silly question for your...but please clear my doubt

rw = Range("l2", Cells(Rows.Count, "l").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row

Smallman · Jul 5, 2014

Hi SG

Sorry for delay been away from home. I didn't use specialcells(xlcelltypevisible). I use and tend to lean towards the index number for this function which is 12.

The specific line you quoted above will give the cell reference for a filtered list. As the cell position is variable this line is flexible enough to capture an ever changing row reference.

Hope this helps you gain some further understanding.

Take Care

Smallman

problem in applying formula by VBA

Member

Attachments

Member

Excel Ninja

Member

Excel Ninja

Excel Ninja

Member

Member

Excel Ninja

Member

Attachments

Member

Attachments

Excel Ninja

Member

Excel Ninja

Attachments

Member

Excel Ninja

Member

Excel Ninja