ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Sub & Function Problem (https://www.excelbanter.com/excel-programming/383914-sub-function-problem.html)

hazel

Sub & Function Problem
 
Hi All

I am having a problem with the sub and function below when I have more than
one (1) entry it works OK however only entering one entry the userform
freezes up and then crashes. I'm using Office enabled macro's 2007 it also
does the same in Excel 97-2003.

Private Sub CmdSheetAdd_Click()
Dim source As Range
Dim ws As Worksheet, wssearch As Worksheet
Dim cell As Range
Dim index As Long
Dim FOUNDFLAG As Boolean

FOUNDFLAG = False
For Each wssearch In Worksheets
If wssearch.Name = Trim(UserForm1.Club1.Value) Then
'To stop cock-ups with sheets of the same name but with spaces
If FOUNDFLAG = False Then
Set ws = wssearch
FOUNDFLAG = True
Else
MsgBox ("Hazel you've two sheets similar name SPACES! Will write
to first sheet found only")
End If
End If
Next wssearch


Sheets("Addistances").Select
'If ws.Name < "Addistances" And ws.Name < "Members" Then
For Each cell In Range(Range("A2"), Range("A2").End(xlDown))
index = matched(cell.Value, ws)
If index 1 Then
ws.Cells(index, 200).End(xlToLeft).Offset(0, 1) _
= cell.Offset(, 1)
ws.Cells(index, 200).End(xlToLeft).Offset(0, 1) _
= cell.Offset(, 2)
End If
Next 'cell
'End If

'Next 'sheet
End Sub
Function matched(item As String, ws As Worksheet) As Long
On Error Resume Next
matched = WorksheetFunction.Match(item, ws.Columns(1), False)
On Error GoTo 0
End Function

Also running in the same program a text to columns works sometimes then
throws a wobbler every so often.

Private Sub CmdOpenDis_Click()

Dim bcell As Range
Dim NotBLank As Boolean


Sheets("Addistances").Select

NotBLank = False
For Each bcell In Range("E2:E500")
If Trim(bcell.Text) < "" Then NotBLank = True
Next bcell

If NotBLank = True Then
Range("E2:E500").Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=True, Other:=True, FieldInfo:= _
Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 1), Array(5,
1)), _
TrailingMinusNumbers:=True
End If

End Sub

In the array I really don't need array 1 or array 2 however they are
included in the csv in an email and this was the only way I could get it to
work sometimes, you lads and lassies out there probably know an easier way. I
appreciate this is a two in one question but I'm really struggling with these
two problems.

Any help greatly appreciated
--
Many thanks

hazel


All times are GMT +1. The time now is 02:14 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com