Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Jun 2011
    Posts
    188
    Thanks
    62
    Thanked 0 Times in 0 Posts

    Delete rows base on string first text and also leave numberic

    Hello Experts !


    Iam trying to delete rows based on first character of text if first character match then delete other rows, it delete fine but iam unable secure the numberic values ? in need to only pick DATE string like that (DATE 01 01 2010 etc) need to pic QMAX all and below QMAX lines its data.??
    HTML Code:
    Sub Test()
    Dim iLastRow As Long
    Dim i As Long
    Dim nCalculation
    
    With Application
    .ScreenUpdating = False
    nCalculation = .Calculation
    .Calculation = xlCalculationManual
    End With
    
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = iLastRow To 1 Step -1
    If Not Left(Cells(i, "A").Text, 1) = "Q" And Not Left(Cells(i, "A").Text, 1) = "D" And Not (Cells(i, "A").Value) >= 0 Then
    Rows(i).Resize(1).Delete
    End If
    Next i
    
    With Application
    .Calculation = nCalculation
    .ScreenUpdating = True
    End With
    
    End Sub
    Attached Files Attached Files

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    I am not exactly sure what you want, could you elaborate using your sample data what the results would be and the logic for getting it?

    Steve

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Is this what you are after?
    Code:
    Option Explicit
    Sub ExtractDateQmax()
      Dim Var1 As Variant
      Dim Var2 As Variant
      Dim dDate As Date
      Dim sTemp As String
      Dim lLastRow As Long
      Dim lRowSource As Long
      Dim lRowResults As Long
      Dim wSource As Worksheet
      Dim wResults As Worksheet
      Dim rCell As Range
      Dim i As Integer
      Dim iCount As Integer
      
      Set wSource = Worksheets("Sheet1")
      Set wResults = Worksheets("Result")
      
      
      lRowResults = 2
      With wSource
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRowSource = 1 To lLastRow
          Set rCell = .Cells(lRowSource, 1)
          If Left(rCell, 4) = "DATE" Then
            sTemp = Application.WorksheetFunction.Trim(rCell)
            Var1 = Split(sTemp, " ")
            dDate = DateSerial(Val(Var1(3)), Val(Var1(2)), Val(Var1(1)))
          End If
          If Left(rCell, 4) = "QMAX" Then
            sTemp = Application.WorksheetFunction.Trim(rCell)
            Var1 = Split(sTemp, " ")
            iCount = UBound(Var1)
            sTemp = Application.WorksheetFunction.Trim(rCell.Offset(1, 0))
            Var2 = Split(sTemp, " ")
            For i = 1 To iCount
              With wResults
                .Cells(lRowResults, 1) = dDate
                .Cells(lRowResults, 2) = Var1(i)
                .Cells(lRowResults, 3) = Var2(i - 1)
                lRowResults = lRowResults + 1
              End With
            Next
          End If
        Next
      End With
    End Sub
    Steve

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •