Snasui Excel Forum

Code: Select all

 
    .Range("q1").Value = "Account"
    If c1 = 0 And c2 > 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 = 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 > 0 And c2 < c1 Then
        .Range("q2").Value = c1 & "*"
        .Range("q3").Value = c2 & "*"
        j = j + 2
    Else
        For i = 0 To c2 - c1
            .Range("q2").Offset(i, 0).Value = c1 + i & "*"
            j = j + i
        Next i
    End If
    Set cri = .Range("q1").Resize(j)
    rs.AdvancedFilter xlFilterCopy, cri, rt
    cri.ClearContents
End With 

Code: Select all

Dim rs As Range, cri As Range
Dim rt As Range
Dim rtBook As Workbook
Dim dbBook As Workbook
Dim r As Range
Dim i As Integer, j As Integer
Dim c1 As Integer, c2 As Integer

Set rtBook = ThisWorkbook
Application.Calculation = xlCalculationManual
With rtBook.Worksheets("result")
    .Range("c2").CurrentRegion.ClearContents
    Set rt = .Range("a2")
    c1 = .Range("t3").Value
    c2 = .Range("v3").Value
End With
Set dbBook = Workbooks.Open(Filename:="C:\Users\toshibaW7\Desktop\Data_1.xlsx")
j = 1 'Criteria rows
With dbBook.Worksheets("sheet1")
    Set rs = .Range("a2", .Range("n" & .UsedRange.Rows.Count))
    With rs.Offset(0, 2).Resize(, 1)
        For Each r In .Cells
            r.Value = "'" & r.Value
        Next r
    End With
    .Range("q1").Value = "Account"
    If c1 = 0 And c2 > 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 = 0 Then
        .Range("q2").Value = c2 & "*"
        j = j + 1
    ElseIf c1 > 0 And c2 > 0 And c2 < c1 Then
        .Range("q2").Value = c1 & "*"
        .Range("q3").Value = c2 & "*"
        j = j + 2
    Else
        For i = 0 To c2 - c1
            .Range("q1").Offset(i + 1, 0).Value = c1 + i & "*"
            j = j + i
        Next i
    End If
    Set cri = .Range("q1").Resize(j)
    rs.AdvancedFilter xlFilterCopy, cri, rt
    With rs.Offset(0, 2).Resize(, 1)
        .NumberFormat = "General"
        .Value = .Value
    End With
    cri.ClearContents
End With
For Each r In rt.CurrentRegion.Offset(0, 2).Resize(, 1).Cells
    r.NumberFormat = "General"
    r.Value = r.Value
Next r
Application.Calculation = xlCalculationAutomatic