View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
JMB JMB is offline
external usenet poster
 
Posts: 2,062
Default Find and remove blanks

I think these will do what you want. Backup before trying.

Sub CleanActiveSheet()
Dim rngCell As Range

For Each rngCell In ActiveSheet.UsedRange.Cells
If IsNumeric(Replace(rngCell.Value, _
" ", "", 1, -1, vbTextCompare)) Then _
rngCell.Value = Replace(rngCell.Value, _
" ", "", 1, -1, vbTextCompare)
Next rngCell

End Sub


Sub CleanAllSheets()
Dim rngCell As Range
Dim wksTemp As WorkSheet

For Each wksTemp In WorkSheets
For Each rngCell In wksTemp.UsedRange.Cells
If IsNumeric(Replace(rngCell.Value, _
" ", "", 1, -1, vbTextCompare)) Then _
rngCell.Value = Replace(rngCell.Value, _
" ", "", 1, -1, vbTextCompare)
Next rngCell
Next wksTemp

End Sub



"Sally Mae" wrote:

I have a macro that does alot of things. It is used for a spreadsheet in
which the user can paste in info from other programs. In order for this to
work my macro must search all used cells, check if their content is purely
numeric i.e. "15545" and "4457676,15" and "546 222 111,333 114" are purely
numeric whereas "AA1" or "Delta 1" is not pure numeric. If the contents of a
cell is purely numeric then the macro shall search the contents inorder to
find blanks and re move them. The reason for this is that Excel cannot add
e.g. "555 111 222" and "500" since the first number is maltreated due to the
blanks. I have written several subs that supposedly did this quuite simple
task and I have also tried recording a macro but they always seem to be
somewhat wrong. I submit code as examples of what I ahve done and if someone
has a piece of code that they know work please post it. I sometimes want to
search an entire workbook and sometimes just a worksheet. Code:

Private Sub findAndRemoveBlanks()

Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub


Another example:

Public Sub findAndRemoveBlanks(s As String)
Dim WB As Workbook
Dim SH As Worksheet
Dim rng, rCell As Range
Set WB = ActiveWorkbook
Set SH = WB.Sheets(s)
Set rng = SH.UsedRange

For Each rCell In rng.Cells
With rCell
If Not IsEmpty(.Value) Then
If Not UCase(.Value) Like "*[A-Z]*" Then
.Replace What:=" ", Replacement:=""
End If
End If
End With
Next rCell
End Sub