index match

phillipus2005

New Member
Joined
Jun 29, 2018
Messages
20
Hi

I have a table with multiple columns and a form that adds data to each of those columns, as a "case". I also have a separate function that adds data to some of those columns, based on the value in column A as a "case update". How do i get the remaining blank cells in that row to fill with data from the "case"?

As an example, a "case" will include Casename, dateopened, location, and Summary (and many others). A "case update" will add a row with Casename and summary but the dateopened and location will not change.

I would normally do this with an index/match function but need to build this in to the Case_update form code...

Any help very welcome

thanks in advance

Phillipus
 

phillipus2005

New Member
Joined
Jun 29, 2018
Messages
20
Hi - I've copied below a mock up of the spreadsheet (can't post actual spreadsheet I'm afraid, as contains confidential data)

I have a macro to insert new cases - below cases 1-8 and insert data into each of the 6 columns here (in reality it's nearer 50 columns). I also have a macro to insert updates (the final two lines in the table below). What I would like to do is pull the type and location from the "case" into the blank fields in the "updates" when those rows are inserted.

Hope that makes sense - can post the code I'm using if that could be helpful...

Phillipus

Case namedate openedtypelocationCase summarynew case
case 101/01/2019Type 1Location 1case summary 1Yes
case 203/03/2019type 2Location 2case summary 2Yes
case 303/05/2019Type 3Location 3case summary 3Yes
case 403/07/2019Type 4Location 4case summary 4Yes
case 502/09/2019Type 5Location 5case summary 5Yes
case 602/11/2019Type 6Location 6case summary 6Yes
case 702/01/2020Type 7Location 7case summary 7Yes
case 803/03/2020Type 8Location 8case summary 8Yes
case 103/03/2019case update 1No
case 104/03/2019case update 2No

<tbody>
</tbody>
 
Last edited:

joshman108

Active Member
Joined
Jul 6, 2016
Messages
310
Yes the code would be helpful. And for clarity, I'm assuming you intend for the final table to look like this, is that correct?

Case namedate openedtypelocationCase summarynew case
case 101/01/2019Type 1Location 1case summary 1Yes
case 203/03/2019type 2Location 2case summary 2Yes
case 303/05/2019Type 3Location 3case summary 3Yes
case 403/07/2019Type 4Location 4case summary 4Yes
case 502/09/2019Type 5Location 5case summary 5Yes
case 602/11/2019Type 6Location 6case summary 6Yes
case 702/01/2020Type 7Location 7case summary 7Yes
case 803/03/2020Type 8Location 8case summary 8Yes
case 103/03/2019Type 1Location 1case update 1No
case 104/03/2019Type 1Location 1case update 2No

<tbody>
</tbody>
 
Last edited:

phillipus2005

New Member
Joined
Jun 29, 2018
Messages
20
Hi. Will post code tomorrow (on work computer) but yes, that’s exactly what I’m looking for...
 

phillipus2005

New Member
Joined
Jun 29, 2018
Messages
20
Hi - here is the code i'm using - new case followed by case update - I've sanitised some of the ranges

you'll see (hopefully) I have two forms: (1) new case - which adds a lot of data to the spreadsheet, and (2) case update - which adds only to a few selected columns. the reason i want to do it this way is that i also have a function that generates a report, tracking all updates to cases over time, and exports it to Word for printing. I initially had "case updates" appending in the TxtCaseSummary field (range(9)) but I am hitting the character limit so want to have each update in a separate row, so i can pull them all into the report

Really grateful for any help... Thanks again in advance

Phillipus


NEW CASE CODE


Code:
Private Sub CmdAddDD_Click()


    FrmDD.Show
    
End Sub


Private Sub CmdClearForm_Click()
'unloads the form then reloads it with default values
    Unload Me
    FrmNewCase.Show
    
End Sub


Private Sub TxtSummaryCase_Change()


End Sub


 Private Sub Userform_Activate()


'put cursor in case name text box
    TxtCaseName.SetFocus
    
'Set the row sources for the comboboxes
    
    CmbType.List = Application.Range("RngType").Value
    CmbPrimaryLocation.List = Application.Range("RngLocations").Value
    CmbPRIVATE1= Application.Range("RngYesNo").Value
    CmbPRIVATE2.List = Application.Range("RngYesNo").Value
    CmbPRIVATE3.List = Application.Range("RngYesNo").Value
    CmbPRIVATE4.List = Application.Range("RngRiskAssessment").Value
    CmbStatus.List = Application.Range("RngStatus").Value


        
'set default text for date text box
    TxtDate.Value = Format(DateTime.Date, "dd-mmm-yyyy")




End Sub


Private Sub TxtDate_GotFocus()
    TxtDate.Text = ""


End Sub


Private Sub CmdEnterNewCase_Click()


Dim ws As Worksheet
Dim lo As ListObject
Dim newrow As ListRow


Set ws = Sheets("Sheet1")
Set lo = ws.ListObjects("Tbl_Input")


With lo
    .AutoFilter.ShowAllData


End With


Set newrow = lo.ListRows.Add(Position:=1) 'put a new role at the top of the table
With newrow 'add the userform inputs to the new row - number = column number
    .Range(1) = TxtCaseName
    .Range(2) = Format(CDate(Me.TxtDate.Value), "DD-MMM-YYYY") 'CDate converts the text to a date
    .Range(3) = CmbType
    .Range(4) = CmbPrimaryLocation
    .Range(7) = TxtLocalLead
    .Range(8) = TxtHQLead
    .Range(9) = Format(CDate(Me.TxtDate.Value), "DD-MMM-YYYY") & " - " & TxtSummaryCase & Chr(10) & Chr(10) & Chr(13) _
    & "==================================START OF CASE RECORDS==================================" _
    & Chr(10) & Chr(10) & Chr(13)
    .Range(12) = "NEW CASE"
    .Range(13) = CmbPRIVATE5
    .Range(14) = CmbPRIVATE6
    .Range(15) = CmbPRIVATE7
    .Range(19) = TxtPRIVATE8
    .Range(22) = TxtOtherContacts
    .Range(25) = TxtPRIVATE9
    .Range(26) = Format(TxtDate, "DD-MMM-YYYY") 'puts case creation date into latest file update field
    .Range(26).NumberFormat = "dd/mmm/yyyy" 'formats the date as dd-mmm-yyyy // removes timestamp
    .Range(27) = Now & " - " & "Case created"
    .Range(29) = CmbPRIVATE10
    .Range(30) = CmbStatus
    .Range(34) = TxtOtherCaseID
    .Range(54) = TxtLink
        
    .Range.EntireRow.WrapText = False 'sets the whole row to no text wrapping
    .Range.EntireRow.Font.Bold = False 'turns off the bold text of new role (picked up from title row in table)
    Application.CutCopyMode = False
        
    'change text in relevant field to hyperlinks - see sub below
    ToHyperlink
        
End With


'unloads the form
    Unload Me
        
'Go to Live Cases Input worksheet
'    ws.Activate


'Show messgae box that new case added successfully
    MsgBox "New case created", vbInformation
    
EndRoutine:


'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True


'Clear The Clipboard
  Application.CutCopyMode = False
  
'Close the userform
    FrmNewCase.Hide


End Sub


'==================================ADD HYPERLINK TO RANGE========================================


' Changes text in column BB2 to a hyperlink, e.g. to internal file system


Sub ToHyperlink()


    Dim cell As Range
    Dim CheckRange As Range


    On Error Resume Next


        Set CheckRange = Sheets("Sheet1").Range("BB2")
        Set CheckRange = Range(CheckRange, Cells(ActiveSheet.Rows.Count, CheckRange.Column).End(xlUp))


    For Each cell In CheckRange.Cells
        cell.Parent.Hyperlinks.Add Anchor:=cell, Address:=cell.Value, TextToDisplay:=cell.Value


    Next cell


    On Error GoTo 0


 End Sub




CASE UPDATE CODE


Code:
'THIS MACRO ADDS A ROW FOR CASE UPDATES, WITH THE DATE OF THE UPDATE IN COLUMN B (CASE OPEN DATE)


Private Sub CmdClearForm_Click()


    Unload Me
    FrmDD.Show
    
End Sub


Private Sub CmdNewCase_Click()


'open new case form
    FrmNewCase.Show
    
 
End Sub




Private Sub Userform_Activate()


'put the cursor in the combobox
    CmbSelectEntity.SetFocus
    
'Set the source for the combobox
'CmbSelectEntity.RowSource = "CaseRange"


'ADD UNIQUE VALUES TO COMBOBOX FROM COLUMN 1 IN TBL_LIVE_CASES-INPUT (MUST REMOVE LISTSOURCE IN COMBOBOX SOURCE PROPERTY)
'AND SORT ALPHABETICALLY
    Dim a As Object
    Dim t As ListObject
    Dim rr As Range, r As Range
    Dim s As String
    
    Set a = CreateObject("system.collections.arraylist")
    Set t = Worksheets("live cases input").ListObjects("Tbl_Live_Cases_Input")


    With t.Range
        .AutoFilter 1, "<>"
        On Error Resume Next
        Set rr = Intersect(.Offset(1), .Columns(1).SpecialCells(xlCellTypeVisible))
        On Error GoTo 0
        If Not rr Is Nothing Then
            For Each r In rr
                s = CStr(r.Value)
                If Not a.contains(s) Then
                    a.Add s
                End If
            Next
            a.Sort
            CmbSelectEntity.List = a.toarray
        End If
    End With
        
'Set default text in date added box
    'txtdateadded.Value = "DD/MM/YY"
    txtdateadded.Value = Format(Now, "DD-MMM-YYYY")


'turn multiline off and on again to solve font size issue
    TxtCaseUpdate.MultiLine = False
    TxtCaseUpdate.MultiLine = True
    TxtCaseUpdate.WordWrap = False
    TxtCaseUpdate.WordWrap = True
   
     
End Sub


Sub CmdEnterAddUpdate_click()


    Dim ws3 As Worksheet
    Dim lo As ListObject
    Dim newrow As ListRow
    Dim lastrow As Long
    Dim r As Long 'This is the counter
    Dim n As Long
    
    Set ws3 = Sheets("Sheet1")
    Set lo = ws3.ListObjects("Tbl_Input")
    
    With lo
    .AutoFilter.ShowAllData
    End With
    
    Set newrow = lo.ListRows.Add(Position:=1) 'put a new role at the top of the table
    
    'Turn off sheet updating
    Application.ScreenUpdating = False
    
    With newrow 'add the userform inputs to the new row - number = column number
        .Range(1) = CmbSelectEntity
        .Range(2) = Format(txtdateadded, "DD-MMM-YYYY")
        .Range(9) = Format(txtdateadded, "DD-MMM-YYYY") & " - " & TxtCaseUpdate & Chr(10) & Chr(10) & _
            Chr(13) & "**********"
        .Range(12) = "CASE UPDATE"
        .Range(26) = Format(txtdateadded, "DD-MMM-YYYY")
        
        .Range.EntireRow.WrapText = False 'sets the whole row to no text wrapping
        .Range.EntireRow.Font.Bold = False 'turns off the bold text of new role (picked up from title row in table)
    
    End With


EndRoutine:


'Sort table by latest file update (column Z) - this allows report to pull records in descending date order
    Dim sortcolumn As Range
    Set sortcolumn = Range("Z1")
    With lo.Sort
        .SortFields.Clear
        .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
        .Header = xlYes
        .Apply
    End With
    


'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True


'Clear The Clipboard
  Application.CutCopyMode = False


'Show messgae box that info added successfully
    MsgBox "Information added to Case Summary", vbInformation


'Clear the input boxes
    TxtCaseUpdate.Text = ""
    CmbSelectEntity.Value = ""


'unload the form
            Unload Me


End Sub
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
358
Office Version
2013
Platform
Windows
Hi
Referring to the layout in post#4
Code:
Sub FILL()
    Dim a As Variant, lr, lr2, i
    Dim d As Object
    lr = Cells(Rows.Count, 4).End(xlUp).Row
    lr2 = Cells(Rows.Count, 1).End(xlUp).Row
    a = Range("a2:a" & lr).Resize(, 4)
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
        If a(i, 1) <> 0 Then
            If Not d.exists(a(i, 1)) Then
                d.Add a(i, 1), a(i, 3) & Chr(164) & a(i, 4)
            End If
        End If
    Next
    For i = lr + 1 To lr2
        Cells(i, 1).Offset(, 2).Resize(, 2) = Split(d(Cells(i, 1).Value), Chr(164))
    Next
End Sub
I know there is better approach, but any way
 
Last edited:

mohadin

Active Member
Joined
Mar 22, 2015
Messages
358
Office Version
2013
Platform
Windows
Another Option
Code:
Sub FILL()
    Dim a As Variant, lr, lr2, i, x
    lr = Cells(Rows.Count, 4).End(xlUp).Row
    lr2 = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(lr + 1, 1).Offset(, 2).Resize(lr2 - lr, 2).FormulaR1C1 = _
    "=INDEX(R2C1:R9C4,MATCH(RC1,R2C1:R9C1,0),COLUMN())"
End Sub
 

phillipus2005

New Member
Joined
Jun 29, 2018
Messages
20
Thanks Mohadin

Could you explain the refernece to "4" in your code? would that change depending on the number of columns in the table?

thanks again

Phillipus
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
358
Office Version
2013
Platform
Windows
Hi
4 is Column 4 ( Column D if you like)
No need to change as long as the missing data to be landed in columns C&D
 

Forum statistics

Threads
1,077,855
Messages
5,336,790
Members
399,102
Latest member
chudson1

Some videos you may like

This Week's Hot Topics

Top