Stuck again. extract data from cell between : &; mulitiple instances

Ozzy_Bruce

New Member
Joined
Oct 16, 2020
Messages
35
Office Version
  1. 365
Platform
  1. Windows
Hi guys, this has me stumped.
I am copying data from an online database that I am wanting to add to my own db, I can copy from the info from the online database and paste in to excel, all good. I have the next sheet pull the data from that paste with a simlpe =, but one of the copied cells includes a heap of data that I want to split in to new columns eg

(General) Status: Active; Secondary Colour: ; Size: Medium; Coat: Fleece; Grading: AL; Microchip: 953010001993799; Owner Note: Nicnak Labradooldes (Health) DNA Result: Clear; Hip Score: 5+7=12; Elbows: 0+0; PennHip: R .41 L .47;

Yes I am a dog breeder

And I would like to capture the data between the : & ; so the first instance would be "Active" then " " then "Fleece" then "AL" and so on. I have googled this to death but only find help on the first instance or data between spaces Etc.
Id love to put the formula in each cell to pull each result.

I am sure that I am going about this the hard way. Copying records from the online Db to Excel to then import in to my own Db. but its a lot faster then copy and paste each field.

Thanks for any help
Cheers Newby

Bruce
 
Peter, is there a way to adjust your formulas to take into account missing semi-colons by peeking at the next field name?
Possibly, although that could be problematic if the final ";" was missing since there is no 'next field name' after PennHip. Even that might be achievable but since the OP does not appear to be interested in my approach (& I have no problem with that BTW) then I don't intend to pursue it further at this stage.
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Possibly, although that could be problematic if the final ";" was missing since there is no 'next field name' after PennHip. Even that might be achievable but since the OP does not appear to be interested in my approach (& I have no problem with that BTW) then I don't intend to pursue it further at this stage.
Sorry Peter I an having trouble keeping up with all the resopnses. I do appricaate your help.
 
Upvote 0
I do appricaate your help.
No problem.

I an having trouble keeping up with all the resopnses.
Me too - I have not kept up with the details of the posts between you and dataluver so I may well be quite out of touch with exactly what you have and what you are trying to achieve. I thought you were pasting text like the original sample into a single cell in Sheet1 and wanted the data split & put into the correct columns in Sheet3 in the next available row. If that is not it then my suggestion in post #18 is not relevant. If that is what you are trying to do (& my two assumptions in post #18 are correct or achievable) then perhaps it might be worth trying out what I suggested in that post.
 
Upvote 0
No problem.


Me too - I have not kept up with the details of the posts between you and dataluver so I may well be quite out of touch with exactly what you have and what you are trying to achieve. I thought you were pasting text like the original sample into a single cell in Sheet1 and wanted the data split & put into the correct columns in Sheet3 in the next available row. If that is not it then my suggestion in post #18 is not relevant. If that is what you are trying to do (& my two assumptions in post #18 are correct or achievable) then perhaps it might be worth trying out what I suggested in that post.
Sure I'll give it go.
Thanks
 
Upvote 0
To include AVK, replace the code in module1 with the code below. The example download includes any updates we have made. I'd still like to try the formula approach to learn and perhaps reduce the amount of code as well.

Module1:
VBA Code:
Option Explicit

Sub TestLoadClipBoard()
    Sheets("Test").Range("A1:H18").Copy
End Sub

Public Sub GetRecord()
    Dim ret(0, 29), i As Integer, GenInfo, GenInfoText As String
    
    Application.ScreenUpdating = False
    Application.Goto Sheets("Dump").Range("A1")
    ActiveSheet.Paste
    
    With ActiveSheet

        ret(0, 0) = .[F1] 'PedigreeNo:
        ret(0, 1) = .[F2] 'Gender:
        ret(0, 2) = .[F3] 'Name:
        ret(0, 3) = .[F4] 'Given name:
        ret(0, 4) = .[F5] 'Breed:
        ret(0, 5) = .[F6] 'Colour:
        ret(0, 6) = .[B8] 'Born:
        ret(0, 7) = .[B11] 'Breed percentage:
        ret(0, 8) = .[F12] 'Father Number:
        ret(0, 9) = .[G12] 'Father Name:
        ret(0, 10) = .[F13] 'Mother Number:
        ret(0, 11) = .[G13] 'Mother Name:
        ret(0, 12) = .[A15] 'Breeder Number:
        ret(0, 13) = .[A16] 'Breeder Name:
        ret(0, 14) = .[A17] 'Breeder Kennel:
        ret(0, 15) = .[E15] 'Owner Number:
        ret(0, 16) = .[E16] 'Owner Name:
        ret(0, 17) = .[E17] 'Owner Kennel:
        ret(0, 18) = .[F9] 'AKV:
        
        GenInfoText = .[A18]
        
        .DrawingObjects.Delete
        .Cells.Clear
        
        GenInfo = ParseGeneralInfo(GenInfoText)
        
        For i = 0 To 10
            ret(0, 19 + i) = GenInfo(i)
        Next
        
    End With
    
    With Worksheets("Results").Range("A1").End(xlDown).Offset(1).Resize(, 30)
        .Value = ret
        Application.Goto .Item(1), True
    End With
    
    Application.ScreenUpdating = True
End Sub

Private Function ParseGeneralInfo(GenInfoText As String)
    Dim i As Integer, ret(10) As String, f As String, t As String
    
    For i = 0 To 10
        f = Choose(i + 1, "Status:", "Secondary Colour:", "Size:", "Coat:", "Grading:", "Microchip:", "Owner Note:", "DNA Result:", "Hip Score:", "Elbows:", "PennHip:")
        ret(i) = GetFieldValue(GenInfoText, f)
    Next
   
    ParseGeneralInfo = ret
End Function

Private Function GetFieldValue(t As String, f As String) As String
    Dim s As String, i As Integer, c As String
    s = Split(t, f)(1)
    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        If c = ";" Then
            GetFieldValue = Trim(Left(s, i - 1))
            Exit Function
        ElseIf c = ":" Then
            Exit Function
        End If
    Next
End Function
 
Upvote 0
Solution
To include AVK, replace the code in module1 with the code below. The example download includes any updates we have made. I'd still like to try the formula approach to learn and perhaps reduce the amount of code as well.

Module1:
VBA Code:
Option Explicit

Sub TestLoadClipBoard()
    Sheets("Test").Range("A1:H18").Copy
End Sub

Public Sub GetRecord()
    Dim ret(0, 29), i As Integer, GenInfo, GenInfoText As String
   
    Application.ScreenUpdating = False
    Application.Goto Sheets("Dump").Range("A1")
    ActiveSheet.Paste
   
    With ActiveSheet

        ret(0, 0) = .[F1] 'PedigreeNo:
        ret(0, 1) = .[F2] 'Gender:
        ret(0, 2) = .[F3] 'Name:
        ret(0, 3) = .[F4] 'Given name:
        ret(0, 4) = .[F5] 'Breed:
        ret(0, 5) = .[F6] 'Colour:
        ret(0, 6) = .[B8] 'Born:
        ret(0, 7) = .[B11] 'Breed percentage:
        ret(0, 8) = .[F12] 'Father Number:
        ret(0, 9) = .[G12] 'Father Name:
        ret(0, 10) = .[F13] 'Mother Number:
        ret(0, 11) = .[G13] 'Mother Name:
        ret(0, 12) = .[A15] 'Breeder Number:
        ret(0, 13) = .[A16] 'Breeder Name:
        ret(0, 14) = .[A17] 'Breeder Kennel:
        ret(0, 15) = .[E15] 'Owner Number:
        ret(0, 16) = .[E16] 'Owner Name:
        ret(0, 17) = .[E17] 'Owner Kennel:
        ret(0, 18) = .[F9] 'AKV:
       
        GenInfoText = .[A18]
       
        .DrawingObjects.Delete
        .Cells.Clear
       
        GenInfo = ParseGeneralInfo(GenInfoText)
       
        For i = 0 To 10
            ret(0, 19 + i) = GenInfo(i)
        Next
       
    End With
   
    With Worksheets("Results").Range("A1").End(xlDown).Offset(1).Resize(, 30)
        .Value = ret
        Application.Goto .Item(1), True
    End With
   
    Application.ScreenUpdating = True
End Sub

Private Function ParseGeneralInfo(GenInfoText As String)
    Dim i As Integer, ret(10) As String, f As String, t As String
   
    For i = 0 To 10
        f = Choose(i + 1, "Status:", "Secondary Colour:", "Size:", "Coat:", "Grading:", "Microchip:", "Owner Note:", "DNA Result:", "Hip Score:", "Elbows:", "PennHip:")
        ret(i) = GetFieldValue(GenInfoText, f)
    Next
  
    ParseGeneralInfo = ret
End Function

Private Function GetFieldValue(t As String, f As String) As String
    Dim s As String, i As Integer, c As String
    s = Split(t, f)(1)
    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        If c = ";" Then
            GetFieldValue = Trim(Left(s, i - 1))
            Exit Function
        ElseIf c = ":" Then
            Exit Function
        End If
    Next
End Function
That’s great thanks.
Now I can compare the 2

I will give the formula approach a go tomorrow.
Thanks Bruce
 
Upvote 0
No problem.


Me too - I have not kept up with the details of the posts between you and dataluver so I may well be quite out of touch with exactly what you have and what you are trying to achieve. I thought you were pasting text like the original sample into a single cell in Sheet1 and wanted the data split & put into the correct columns in Sheet3 in the next available row. If that is not it then my suggestion in post #18 is not relevant. If that is what you are trying to do (& my two assumptions in post #18 are correct or achievable) then perhaps it might be worth trying out what I suggested in that post.
Thanks Peter. I have tested post 18 and uploaded acopyof the wb. "Zoo Import Test 3" It does split the data nicely but I am still stuck in the pasting to sheet 1 cell A1 with the merged cell business. What I have done is to paste the copied data to a different part of the sheet and then copy it again and post to A1. the workings sheet updates well then I copy the row and paste its values to a new line on sheet Result.

Lots of steps.

The Macro version from dataluver makes quick work of the import with the copy from the webpage and click the buttom but with the missing ; within the data some of the lasts fields have moved to the left. As I am not manually pasting the data I cannot just add the missing ; and I need to adjust the results. Still it is a lot faster then retyping the whole page.

Unsure where to from here but thank you all for your help.

Bruce
 
Upvote 0
I am still stuck in the pasting to sheet 1 cell A1 with the merged cell business.
I'm not understanding exactly what the issue there is or how it relates to your original question.
 
Upvote 0
I'm not understanding exactly what the issue there is or how it relates to your original question.
Once I have copied data from a webpage I am unable to paste it on to sheet 1 as there is still formatting there from the last paste, this includes to cell that we ahve been splitting the data from.
Not sure I understand either Peter.
Cheers
Bruce
 
Upvote 0
Could the code you have be adjusted to remove all formatting from that sheet 1 range once it has copied the data to the results sheet?
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,162
Members
448,554
Latest member
Gleisner2

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