Extracting elements of a string cell

[PK]

I have various cells some of which hold an alpha-number field, some hold an
alpha-number-alpha-number field, some are blank. These range for example from
cells C3:G3 as follows starting at C3
H7.5 blank H3.5L4.5 blank L7.5
I would like to sum all numbers prefixed with H and seprately, all prefixed
with L
Hence the result from above should read - Total for H is 11 Total for L is
12.
I have 2 separate formulas as follows which work until you input an H value
and an L value into the same field.
=SUM(IF(LEFT(C3:G3)="H",RIGHT(C3:G3,LEN(C3:G3)-1)*1))
=SUM(IF(LEFT(C3:G3)="L",RIGHT(C3:G3,LEN(C3:G3)-1)*1))
I am aware this is an array formula and one must complete the shift control
enter to obtain curved brackets around the formula.
Any assistance to solve my issue would be very much appreciated.
For info H = holiday taken. L = Lieu time taken.
On some days the staff merge H with acquired L to make up a day off.
Thanks,
PK

 

[Mike H]

Hi,

How about a user defined function. Alt+F11 to open VB editor. Right click
'ThisWorkbook' and insert module and paste the code below in

call the code with

=addtime(rng,"L")

where rng is the range to count and "L" is the letter to sum so for your
example

=addtime(C3:G3,"h")


Function addtime(rng As Range, ltr As String)
Dim ts As String
Dim x As Long
ltr = UCase(ltr)
For Each c In rng
If InStr(UCase(c.Value), ltr) > 0 Then
For x = InStr(UCase(c.Value), ltr) To Len(c.Value)
If IsNumeric(Mid(c.Value, x, 1)) Or Mid(c.Value, x, 1) = "." Then
ts = ts + Mid(c.Value, x, 1)
If Not IsNumeric(Mid(c.Value, x + 1, 1)) And _
Mid(c.Value, x + 1, 1) <> "." Then Exit For
End If
Next
End If
If ts <> "" Then
addtime = addtime + Val(ts)
ts = ""
End If
Next
End Function

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PK]

Hi Mike,
Wow!! That works perfectly. I have a follow on question though.
I have a second formula that calculates if the "holiday" has been taken
taking into account the current date (which is held in cell A2) and if it has
passed my column header dates held in row 2 from C2 onwards. This formula is
as follows:
=SUM(IF(LEFT(C3:G3)="H",RIGHT(C3:G3,LEN(C3:CN3)-1)*1*($C$2:$CN$2<=$A$2)))
How do I amend this to incorporate your =addtime(C3:CN3,"H") formula?
Currently its giving me a VALUE error bcause of the merging in one cell of
for example H3.5L4.5.
Thanks.

 

[Mike H]

Hi,

The formula you posted won't work because the ranges are different lengths.
I think your saying that if the date in the row above the string is 'in the
future then ignore it. Try this

Function addtime(rng As Range, ltr As String)
Dim ts As String
Dim x As Long
ltr = UCase(ltr)
For Each c In rng
If c.Offset(-1, 0) > Range("A2").Value Then GoTo getmeout
If InStr(UCase(c.Value), ltr) > 0 Then
For x = InStr(UCase(c.Value), ltr) To Len(c.Value)
If IsNumeric(Mid(c.Value, x, 1)) Or Mid(c.Value, x, 1) = "." Then
ts = ts + Mid(c.Value, x, 1)
If Not IsNumeric(Mid(c.Value, x + 1, 1)) And _
Mid(c.Value, x + 1, 1) <> "." Then Exit For
End If
Next
End If
If ts <> "" Then
addtime = addtime + Val(ts)
ts = ""
End If
getmeout:
Next
End Function
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Mike H]

Ah,

I understand what your saying. Your validation date is 'always' in row 2 but
the holiday coluld be in any row so if we are in row 9 we still colpare the
date in row 2 to the date in a2. Try this instead:-

Function addtime(rng As Range, ltr As String)
Application.Volatile
Dim ts As String
Dim x As Long
Dim DateRow As Long
ltr = UCase(ltr)
For Each c In rng
If Cells(2, c.Column).Value > Range("A2").Value Then GoTo getmeout
If InStr(UCase(c.Value), ltr) > 0 Then
For x = InStr(UCase(c.Value), ltr) To Len(c.Value)
If IsNumeric(Mid(c.Value, x, 1)) Or Mid(c.Value, x, 1) = "." Then
ts = ts + Mid(c.Value, x, 1)
If Not IsNumeric(Mid(c.Value, x + 1, 1)) And _
Mid(c.Value, x + 1, 1) <> "." Then Exit For
End If
Next
End If
If ts <> "" Then
addtime = addtime + Val(ts)
ts = ""
End If
getmeout:
Next
End Function
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PK]

This will sound dumb I know but does your second piece of VBA also accomodate
my first request? ie can I use this coding to calculate holiday booked (ie my
first request) and holiday taken (ie my second request) in two separate
result cells? Also if I need to replace the first piece of code you sent me
how do I open the existing code within VB? I am a total novice in VB and as I
say prob a dumb question but please let me know anyway

 

[Mike H]

Hi,

It doesn't sound 'dumb' if you don't know it's because you're learning.

The first code I gave you sums all data i.e. holidays booked and not taken
and holidays taken and takes no account of dates because you hadn't mentioned
dates by then

The last code I gave you sums a range as did the first code I gave you but
'in addition' it looks in row 2 of the appropriate column for a date and
compares that date to A2 and only sums the range if the date in row 2 is
earlier or the same as the date in A2. so in effect it sums only 'holidays
taken'

What I now think you want it to be able to do both with one piece of code so
try this
Yiu now have to specify a third option when you call the function

=addtime(C3:G3,"H","T") ' Holidays taken
=addtime(C3:G3,"H","B") ' holidays booked but not taken
=addtime(C3:G3,"H","BT") ' All Holidays booked and taken

Function addtime(rng As Range, ltr As String, bkd As String)
Application.Volatile
Dim ts As String
Dim x As Long
Dim DateRow As Long
ltr = UCase(ltr)
bkd = UCase(bkd)

For Each c In rng

If bkd = "T" Then
If Cells(2, c.Column).Value > Range("A2").Value Then GoTo getmeout
ElseIf bkd = "B" Then
If Cells(2, c.Column).Value < Range("A2").Value Then GoTo getmeout
End If

If InStr(UCase(c.Value), ltr) > 0 Then
For x = InStr(UCase(c.Value), ltr) To Len(c.Value)
If IsNumeric(Mid(c.Value, x, 1)) Or Mid(c.Value, x, 1) = "." Then
ts = ts + Mid(c.Value, x, 1)
If Not IsNumeric(Mid(c.Value, x + 1, 1)) And _
Mid(c.Value, x + 1, 1) <> "." Then Exit For
End If
Next
End If
If ts <> "" Then
addtime = addtime + Val(ts)
ts = ""
End If
getmeout:
Next
End Function

To instal the new code. ALT+F11 to open VB editor double click
'ThisWorkbook' and then double click 'Module1'.

On the right hand side delete all of the first code I gave you and then
paste in the latest code. call the new code in the same way as before.
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PK]

Thanks for the prompt response. However my prob is opening module 1. After I
Alt F11 I get VB Editor but with a grey screen and no option to click on
'This Workbook' hence cannot view module 1 although I know it's in there
somewhere because the initial code you sent works. I am running Excel 2003
SP2 if that makes any difference. Really frustrated now as I feel I am nearly
at a conclusion with this minor irritation stopping me. Any ideas?

 

[Mike H]

Do you have the menu options at the top of the screen after pressing ALT+F11

If so then 'View' - Select 'Project Explorer' and you should then be able to
navigate to Module1
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PK]

Thanks can now view the modules - so simple really.
Have encountered further issues though. I decided to go with your first
piece of code to calculate Hols Booked and Lieu Booked which splits the 2
definitions perfectly if keyed into one cell.
The additional cell that calculates Hols Taken I decided to use your 2nd
piece of code, as follows, but created a second module and called the
function addtimeb just to differentiate:

Function addtimeb(rng As Range, ltr As String)
Application.Volatile
Dim ts As String
Dim x As Long
Dim DateRow As Long
ltr = UCase(ltr)
For Each c In rng
If Cells(2, c.Column).Value > Range("A2").Value Then GoTo getmeout
If InStr(UCase(c.Value), ltr) > 0 Then
For x = InStr(UCase(c.Value), ltr) To Len(c.Value)
If IsNumeric(Mid(c.Value, x, 1)) Or Mid(c.Value, x, 1) = "." Then
ts = ts + Mid(c.Value, x, 1)
If Not IsNumeric(Mid(c.Value, x + 1, 1)) And _
Mid(c.Value, x + 1, 1) <> "." Then Exit For
End If
Next
End If
If ts <> "" Then
addtimeb = addtimeb + Val(ts)
ts = ""
End If
getmeout:
Next
End Function

Works great on one worksheet (Feb 2010) but when I add it to a second
worksheet, in the future, (Apr10) (I have 12 one for each month), it makes
the Feb sheet return a zero when it previously held correct data of Hols
Taken as they has passed todays date. Hope this makes sense. So difficult to
explain these things sometimes. Thanks so much.

 

[PK]

Hi,
Has my earlier post today may you decide that I have exhausted your
patience? I so want to achieve this task but if you cannot assist please
letme know. Will understand.
PK

 

[PK]

Apologies for bombarding you with comms.
I have found what the issue is just unable to fix it myself.
In the following code the workbook is looking up Column 2 for the dates to
compare against cell A2 (curent date) and applying the result to all
worksheets regardless of which worksheet is being updated. What should happen
is each individual worksheet should look at its own Column 2 (which differs
as a date field within each worksheet) and compare it against each cell A2
(which is identical for all worksheets as current date). Not updating all
worksheets against column 2 of the one being updated. Hope that is not clear
as mud.

Function addtimeb(rng As Range, ltr As String)
Application.Volatile
Dim ts As String
Dim x As Long
Dim DateRow As Long
ltr = UCase(ltr)
For Each c In rng
If Cells(2, c.Column).Value > Range("A2").Value Then GoTo getmeout
If InStr(UCase(c.Value), ltr) > 0 Then
For x = InStr(UCase(c.Value), ltr) To Len(c.Value)
If IsNumeric(Mid(c.Value, x, 1)) Or Mid(c.Value, x, 1) = "." Then
ts = ts + Mid(c.Value, x, 1)
If Not IsNumeric(Mid(c.Value, x + 1, 1)) And _
Mid(c.Value, x + 1, 1) <> "." Then Exit For
End If
Next
End If
If ts <> "" Then
addtimeb = addtimeb + Val(ts)
ts = ""
End If
getmeout:
Next
End Function

I am hoping its a simple code change.
Thanks.