VBA ARRAY CODE HELP

roykana

Active Member
Joined
Mar 8, 2018
Messages
311
Office Version
  1. 2010
Platform
  1. Windows
Dear all master,
Please help for vba array code remove numbers based on specific contents of cell.

ORIIGINAL
ORIGINAL.PNG




RESULT

RESULT.PNG


So remove the numbers based on the contents of the word "KANA".


Thanks

roykana
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
paste the code into a module, then run ClearNumsVia1Word.
enter the name of the person to find, it will erase the numbers.

Code:
Sub ClearNumsVia1Word()
Dim vWord, vChr
Dim i As Integer
Dim vCellVal
vWord = InputBox("Enter name to find", "Remove # from name")
If vWord = "" Then Exit Sub
vWord = UCase(vWord)
Range("A1").Select
While ActiveCell.Value <> ""
   vCellVal = UCase(ActiveCell.Value)
   If InStr(vCellVal, vWord) > 0 Then
     
      'MsgBox vCellVal, , "found"
      For i = Len(vCellVal) To 1 Step -1
          If Not IsNumeric(Mid(vCellVal, i, 1)) Then
            ActiveCell.Value = Left(vCellVal, i)
            GoTo skipNext
          End If
         
      Next
   End If
   
skipNext:
   ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub
 
Upvote 0
paste the code into a module, then run ClearNumsVia1Word.
enter the name of the person to find, it will erase the numbers.

Code:
Sub ClearNumsVia1Word()
Dim vWord, vChr
Dim i As Integer
Dim vCellVal
vWord = InputBox("Enter name to find", "Remove # from name")
If vWord = "" Then Exit Sub
vWord = UCase(vWord)
Range("A1").Select
While ActiveCell.Value <> ""
   vCellVal = UCase(ActiveCell.Value)
   If InStr(vCellVal, vWord) > 0 Then
    
      'MsgBox vCellVal, , "found"
      For i = Len(vCellVal) To 1 Step -1
          If Not IsNumeric(Mid(vCellVal, i, 1)) Then
            ActiveCell.Value = Left(vCellVal, i)
            GoTo skipNext
          End If
        
      Next
   End If
  
skipNext:
   ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub

Thank you for your reply. I want to immediately set the name in the code and I try 5000 records running very slowly. if you make a vba array code it might be faster
 
Upvote 0
Don't quote whole posts. Just a bunch of extra clutter.
Refer to a Post number if required.
Code:
Sub Maybe_So()
Dim c As Range
    For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Left(c, 4) = "KANA" Then c.Value = Left(c, InStrRev(c, " ") - 1)
    Next c
End Sub
Code:
Sub Or_Maybe_So()
Dim aArr, i As Long
aArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(aArr) To UBound(aArr)
        If Left(aArr(i, 1), 4) = "KANA" Then aArr(i, 1) = Left(aArr(i, 1), InStrRev(aArr(i, 1), " ") - 1)
    Next i
Range("A1").Resize(UBound(aArr)) = Application.Index(aArr, , 1)
End Sub
Code:
Sub Or_Maybe_Even_So()
Const strCol = "A" ' column
Const strText = "KANA" ' text to look for
Dim lngLast As Long, c As Range
lngLast = Range(strCol & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    With Range(strCol & "1:" & strCol & lngLast)
        .AutoFilter Field:=1, Criteria1:=strText & "*"
            For Each c In Range("A2:A" & lngLast).SpecialCells(12)    'strCol & "1:" & strCol & lngLast).Offset(1).SpecialCells(12)
                c.Value = Left(c, InStrRev(c, " ") - 1)
            Next c
        .AutoFilter
    End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Don't quote whole posts. Just a bunch of extra clutter.
Refer to a Post number if required.
Code:
Sub Maybe_So()
Dim c As Range
    For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Left(c, 4) = "KANA" Then c.Value = Left(c, InStrRev(c, " ") - 1)
    Next c
End Sub
Code:
Sub Or_Maybe_So()
Dim aArr, i As Long
aArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(aArr) To UBound(aArr)
        If Left(aArr(i, 1), 4) = "KANA" Then aArr(i, 1) = Left(aArr(i, 1), InStrRev(aArr(i, 1), " ") - 1)
    Next i
Range("A1").Resize(UBound(aArr)) = Application.Index(aArr, , 1)
End Sub
Code:
Sub Or_Maybe_Even_So()
Const strCol = "A" ' column
Const strText = "KANA" ' text to look for
Dim lngLast As Long, c As Range
lngLast = Range(strCol & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    With Range(strCol & "1:" & strCol & lngLast)
        .AutoFilter Field:=1, Criteria1:=strText & "*"
            For Each c In Range("A2:A" & lngLast).SpecialCells(12)    'strCol & "1:" & strCol & lngLast).Offset(1).SpecialCells(12)
                c.Value = Left(c, InStrRev(c, " ") - 1)
            Next c
        .AutoFilter
    End With
Application.ScreenUpdating = True
End Sub
dear Jolivanes,
sorry I'm late to reply to you. thank you very much for your reply
of the three codes running perfectly. There is a little problem I want to ask you.
1. If I use the text "kana" with 100,000 records, the error is in the "Sub Or_Maybe_So()" code, which is run time error 13.
What is the cause and what is the solution?.
2. If the text is more than one what to use code like "Sub toCall() Call Call call End Sub" or any other solution from you.

Thanks
roykama
 
Upvote 0
2. If the text is more than one what to use ..
Can you be more specific with what you have and what you are trying to achieve?

Also, when you get a code error, please give the full error message and identify which line of the code gives the error.
 
Upvote 0
Can you be more specific with what you have and what you are trying to achieve?
it means that the text criteria are more than one example I use text"kana","budi","joko" so what is the solution in the code. whether to call each sub code for each text or is there another solution. And I just want the process to be fast for many records. from the code that jolivanes gave it was perfect, there was only an error in one of the codes because 100,000
the record. the code below:
VBA Code:
Sub Or_Maybe_So()
Dim aArr, i As Long
aArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(aArr) To UBound(aArr)
        If Left(aArr(i, 1), 4) = "KANA" Then aArr(i, 1) = Left(aArr(i, 1), InStrRev(aArr(i, 1), " ") - 1)
    Next i
Range("A1").Resize(UBound(aArr)) = Application.Index(aArr, , 1) 'error in this line
End Sub
Thanks
roykana
 

Attachments

  • ERROR-1.PNG
    ERROR-1.PNG
    5.3 KB · Views: 14
  • ERROR-2.PNG
    ERROR-2.PNG
    12.8 KB · Views: 15
Upvote 0
I have not been able to reproduce that error on that line of the code, even with 1000,000 rows.

Does it make any difference if you change that marked line to this?
VBA Code:
Range("A1").Resize(UBound(aArr)) = aArr

Do you have any error values in the column?
 
Upvote 0
I have not been able to reproduce that error on that line of the code, even with 1000,000 rows.

Does it make any difference if you change that marked line to this?
VBA Code:
Range("A1").Resize(UBound(aArr)) = aArr

Do you have any error values in the column?
no error found
 
Upvote 0
Any good reason why the 20+ lines of code from Post #2 are repeated in Post #3?
Any good reason why the 30+ lines of code from Post #4 are repeated in Post #5?
Just read the very first line of Post #4 again.
 
Upvote 0

Forum statistics

Threads
1,212,928
Messages
6,110,734
Members
448,294
Latest member
jmjmjmjmjmjm

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