Read and write to UserForm from filtered list. 2

[neiljabba]

Hello all

I have reached a desperate point which I would really appreciate help on.

The code below was orginally used on an unfiltered list with the data populating it spread on separate worksheets. It worked without any problems.

I have now centralised the data on one sheet for easier management and filter for what I need. The problem I have is that I cant make it populate the form from the filtered list and certainly cant write back to the vacant cells relevant to it.

There is another issue!!! The code now needs to identify if there is a vacant cell next to the entry and then if so write as normal if not insert a new column to accomodate the data. The new columns would be in a named range of columns e.g. "Register".

Therefore it needs a check to make sure that there is space and because its a filtered list make sure that any other filtered option follows the same process i.e only inserts a new column if no blank available. That means if one instance of the filter needed a new column the others would not until they filled the blanks created by it.

Anyway heres the code



Public Sub CommandButton1_Click()'appears on form

Let i = 0
Let r = 5

'inserts column for updated data including current date
' The date would be replaced by a comment added to each cell written to showing the current date
Columns("D").Select
Selection.Insert Shift:=xlToRight
Range("D3").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
copieddate = Cells(3, 4).Value ' copies the date so that the fomula doesnt cause problems
Cells(3, 4) = copieddate
Range("D333").Select
'obviously for appearance purposes only the follwing formats the column
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'loop to insert marks as present or absent dependent on checkbox value and whether its there or not
For i = 1 To 30

If Me.Controls("CheckBox" & i).Value = True Then Cells(r, 4) = "/" Else Cells(r, 4) = "A"
If Me.Controls("CheckBox" & i).Visible = False Then Cells(r, 4) = ""

r = r + 1
Next i


UserForm1.Hide

End Sub
Public Sub UserForm_Initialize()


Let i = 0 'index for checkbox
Let r = 5 ' index for row number


'loop to define checkbox caption values if false then no checkbox
For i = 1 To 30
If Cells(r, 1) = "" Then Me.Controls("CheckBox" & i).Visible = False Else Me.Controls("CheckBox" & i).Caption = Cells(r, 1) & " " & Cells(r, 2)
r = r + 1
Next i

End Sub

This may be alot to ask but it has reached the final piece in a big jigsaw so to speak.

Many thanks in advance.

Neil

 

[neiljabba]

Sorry just to add the final form initialise will be RUN from an msoCommandBar button. Will this solve it?

Cheers

Neil

 

[xlbo]

reset all the values where ??

standard practice is to call a little cleanup routine at the end of the sub

Rgds, Geoff

Never test the depth of water with both feet

Help us to help you by reading FAQ222-2244 before you ask a question

 

[neiljabba]

The checkbox captions and the values because it displays all the previous values unless it is RUN again.

If I clean up at the end of the sub it will be pointless as the commanbutton click populates the cells adjacent to the filtered values. It does work at the beginning but as I said only when I have stopped the code and re-RUN it.




Cheers

Neil

 

[neiljabba]

Hello one more time I think.

Ignoring the problem above I am trying to format ALL cells within the list, to have gird lines around the cell, including the hidden cells, so that when the filter is removed all cells have been formatted the same.

As you can imagine it works fine for the unhidden cells but leaves blanks around the filtered values the code is

Public Sub testingblanks()

lRow = Cells(65536, 1).End(xlUp).Row


For r = 3 To lRow

If (Worksheets("Sheet1").Rows(r).Hidden = False And (Cells(r, 4) <> "")) Then

Module1.addcol

End
Else

UserForm1.Show
End


End If


Next r






End Sub


Public Sub addcol()

Columns("D").Select
Selection.Insert Shift:=xlToRight

Range("d3:d194").Select

'Do stuff




'obviously for appearance purposes only the follwing formats the column
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With



Cells(1, 1).Select
UserForm1.Show



End Sub


Is this possible?It makes the eerything easier to read thats all.

If it is Im done hurray!!!!!

Cheers

Neil