Datagridview custom row highlight - winforms

I have a DataGridView (WinForms, C#). All I wanted to do is to divide grid on left/ right parts. So, when I click on left part (3,3) will highlights for example, when click on right part (6,6) will be highlighted.
Col1 | Col2 | Col3 | Col4
-------------------------
1 1 2 2
3 3 4 4
5 5 6 6
Getting the value not a problem, but highlights.. ?
int iCol = dgv.CurrentCell.ColumnIndex;
if (iCol == 0 || iCol == 1) // left side
{
}
else // right side
{
}

I hope this helps you, but you should not write column indexes directly in code, I think coltroling indexes with mathematical expression is better solution.
Also this code would be slow with big data, so that you can use column select. But if you use column select, it would prevent reordering rows when you clicked column header.
Private Sub DataGridView1_CellClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellClick
DataGridView1.SelectionMode = DataGridViewSelectionMode.CellSelect
If e.ColumnIndex < DataGridView1.ColumnCount / 2 Then
For Each c As DataGridViewColumn In DataGridView1.Columns
If c.Index < DataGridView1.ColumnCount / 2 Then
For Each r As DataGridViewRow In DataGridView1.Rows
r.Cells(c.Index).Style.BackColor = Color.Blue
Next
Else
For Each r As DataGridViewRow In DataGridView1.Rows
r.Cells(c.Index).Style.BackColor = Color.Gray
Next
End If
Next
Else
For Each c As DataGridViewColumn In DataGridView1.Columns
If c.Index >= DataGridView1.ColumnCount / 2 Then
For Each r As DataGridViewRow In DataGridView1.Rows
r.Cells(c.Index).Style.BackColor = Color.Blue
Next
Else
For Each r As DataGridViewRow In DataGridView1.Rows
r.Cells(c.Index).Style.BackColor = Color.Gray
Next
End If
Next
End If
End Sub

Related

Looping through Unique Data Set to Return Matching Value on a Different Sheet

I have searched for something similar to what I am asking, and unfortunately there is nothing close to what I am looking for.
I have a unique data set here on Sheet(2): The goal is to return the values in the highlighted blue columns if it matches the same "Item#" for the box selected in a dropdown list of the box names on Sheet(1). Please see Sheet(1) here: Sheet(1) Set-Up.
The Item#'s on Sheet(1) are located in B3:B12 on Sheet(1). - I've added also another list where I would like my code to run In the column next to this is a blank where the matching items in blue would post.
I am trying to use For Loops to accomplish this. I understand that the data set is weird, but I want to keep it like that for the mere challenge of it (and also because I have a larger data set similar and am just using this as a test run)... My code so far is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' In order to run code on sheet without a button or enabling in a module
Set KeyCells = Range("A1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Dim i, j As Long
Dim n As Long
Dim box As String
Set sh2 = ThisWorkbook.Sheets(2)
Set rn2 = sh2.UsedRange
box = Sheets(1).Cells.Range("A1")
Dim k1 As Long
k1 = rn2.Rows.Count + rn2.Row - 1
n = 0
For i = 1 To k1
If Sheets(2).Cells(1, i) = box Then
If n = 0 Then
Sheets(1).Cells(3, 3).Value = Sheets(2).Cells(i, 2)
n = n + 1
End If
ElseIf n > 0 Then
For j = 3 To n + 2
If Sheets(2).Cells(2, i).Value = Sheets(1).Cells(j, 2).Value Then
If Sheets(2).Cells(2, i).Value <> Sheets(1).Cells(j, 2).Value Then
x = x
Else
x = x + 1
End If
End If
Next
If x = 0 Then
Sheets(1).Cells(3 + n, 3).Value = Sheets(2).Cells(2, i).Value
n = n + 1
End If
End If
x = 0
Next
End If
End Sub
Please let me know what you experts think!
Edit 2; the macro finds Sheet1.Range("A1").Value in Sheet2 row 1. It then loops through each cell below the found value in Sheet2. It then finds each cells value in Sheet1. It will then copy the cells value in Sheet2 from the next cell to the right, and place the value in the cell in Sheet1 to the next cell to the right. It then loops down to the next cell in sheet2, and performs the same task, etc.
Private Sub Worksheet_Change(ByVal target As Range) 'Works
Dim fndTrgt As Range, fndCel As Range
If target.Address = "$A$1" Then
Set fndTrgt = Sheets("Sheet2").Rows(1).Find(target.Value)
If Not fndTrgt Is Nothing Then
For i = 1 To 5
Set fndCel = Sheets("Sheet1").Range("A2:D12").Find(fndTrgt.Offset(i).Value)
If Not fndCel Is Nothing Then
fndCel.Offset(, 1).Value = fndTrgt.Offset(i, 1).Value
End If
Next i
End If
End If
End Sub

ShapeRange Objects are acting weirdly

Sorry if this is long. I had to explain everything.
I have the following three moduels:
1. CreateDemoMap
2. CreateDemoTable
3. Update
The CreateDemoMap will go through a table and get the location (Top and Left), size (Width and Length), Name, Rotation and title of shapes and place them on the screen. Basically, it will build a map. This is the main part of my code:
For i = 2 To endNum 'input the number manual for now
Top = Workbooks("Reference").Worksheets("Directory").Cells(i, 2)
Left = Workbooks("Reference").Worksheets("Directory").Cells(i, 3)
Width = Workbooks("Reference").Worksheets("Directory").Cells(i, 4)
Height = Workbooks("Reference").Worksheets("Directory").Cells(i, 5)
Name = Workbooks("Reference").Worksheets("Directory").Cells(i, 6)
Rotation = Workbooks("Reference").Worksheets("Directory").Cells(i, 7)
Title = Workbooks("Reference").Worksheets("Directory").Cells(i, 8)
Set sh = w.Shapes.AddShape(msoShapeRectangle, Left, Top, Width, Height)
sh.Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Rotation = Rotation
Selection.ShapeRange.Title = Title
Selection.ShapeRange.Name = Name
Next i
Here is a screenshot of my table and the map:
Map & Table
Next, I thought it would be cool to go through the shape range array and get the properties of each objects. Also, it enabled me get the shape ID.
Sub Test1()
Dim Top As Long
Dim Left As Long
Dim Width As Long
Dim Height As Long
Dim ID As String
Dim Name As String
Dim Rotation As String
Dim Title As String
Dim sh As Object
Dim endNum As Integer
CreateSheet ("DemoTable")
totalShape = 90
rnr = 2
IndexNum = 0
Worksheets("DemoMap").Activate
For Each shp In ActiveSheet.Shapes
IndexNum = IndexNum + 1
Worksheets("DemoTable").Cells(rnr, 1) = IndexNum
Worksheets("DemoTable").Cells(rnr, 2) = shp.Top
Worksheets("DemoTable").Cells(rnr, 3) = shp.Left
Worksheets("DemoTable").Cells(rnr, 4) = shp.Width
Worksheets("DemoTable").Cells(rnr, 5) = shp.Height
Worksheets("DemoTable").Cells(rnr, 6) = shp.ID
Worksheets("DemoTable").Cells(rnr, 7) = shp.Name
Worksheets("DemoTable").Cells(rnr, 9) = shp.Rotation
Worksheets("DemoTable").Cells(rnr, 10) = shp.Title
Worksheets("DemoTable").Cells(rnr, 11) = shp.Type
rnr = rnr + 1
Next shp
End Sub
This is how it looks like:
Shape Table
Objectives:
A. update the Top, Left, and rotation of the shapes if the objects were moved or rotated.
B. Be able to account for deleted and added shapes
Solutions:
A. Since there wasn't an event listener in VBA, I decided to let the user move the objects however she want and then click a button that would update the table you saw earlier. Here is my code for this sub:
Sub UpdateShapes()
Dim Top As Long
Dim Left As Long
Dim Width As Long
Dim Height As Long
Dim ID As String
Dim Name As String
Dim Rotation As String
Dim Title As String
Dim sh As Object
Dim endNum As Integer
Dim Changes As Integer
Dim JSBChanges As Integer
Dim OneChanges As Integer
Dim TwoChanges As Integer
Dim ThreeChanges As Integer
Dim M1Changes As Integer
Dim M2Changes As Integer
Dim Deleted As Integer
Dim myDoc As Worksheet
Dim ShapeNum As Integer
Dim ShapeIndex As Integer
JSBChanges = 0
OneChanges = 0
TwoChanges = 0
ThreeChanges = 0
M1Changes = 0
M2Changes = 0
Deleted = 0
Set myDoc = Workbooks("Reference").Worksheets("DemoMap")
ShapeNum = myDoc.Shapes.Count
Debug.Print ("ShapeNum is: " & ShapeNum)
Workbooks("Reference").Worksheets("DemoMap").Activate
TableIndex = 2
ShapeIndex = 1
While (TableIndex <= (ShapeNum + 1))
Changes = 0
If(Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 6) = myDoc.Shapes.Range(ShapeIndex).ID) Then
If (Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 2) <> myDoc.Shapes.Range(ShapeIndex).Top) Then
Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 2) = myDoc.Shapes.Range(ShapeIndex).Top
Changes = Changes + 1
End If
If (Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 3) <> myDoc.Shapes.Range(ShapeIndex).Left) Then
Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 3) = myDoc.Shapes.Range(ShapeIndex).Left
Changes = Changes + 1
End If
If (Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 9) <> myDoc.Shapes.Range(ShapeIndex).Rotation) Then
Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 9) = myDoc.Shapes.Range(ShapeIndex).Rotation
Changes = Changes + 1
End If
If (Changes >= 1) Then
With myDoc.Shapes.Range(ShapeIndex).Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Select Case (myDoc.Shapes.Range(ShapeIndex).Title)
Case "JSB"
JSBChanges = JSBChanges + 1
Case "1"
OneChanges = OneChanges + 1
Case "2"
TwoChanges = TwoChanges + 1
Case "3"
ThreeChanges = ThreeChanges + 1
Case "M1"
M1Changes = M1Changes + 1
Case "M2"
M2Changes = M2Changes + 1
End Select
End If
Else
Deleted = Deleted + 1
Workbooks("Reference").Worksheets("DemoTable").Rows(TableIndex).Interior.ColorIndex = 3
Workbooks("Reference").Worksheets("DemoTable").Rows(TableIndex).Font.ColorIndex = 2
ActiveWorkbook.Save
ShapeIndex = ShapeIndex - 1
End If
TableIndex = TableIndex + 1
ShapeIndex = ShapeIndex + 1
ShapeNum = myDoc.Shapes.Count
Wend
MsgBox ("JSBChanges: " & JSBChanges)
MsgBox ("OneChanges: " & OneChanges)
MsgBox ("TwoChanges: " & TwoChanges)
MsgBox ("ThreeChanges: " & ThreeChanges)
MsgBox ("M1Changes: " & M1Changes)
MsgBox ("M2Changes: " & M2Changes)
MsgBox ("Deleted: " & Deleted)
End Sub
Let's assume no shape has been added or deleted, which means the shaperange array should have the same number of objects. Thru. trail and error, I also discovered that the array elements won't move around and will stay still if you move your objects around. So, as you see, the code will compare the elements inside the DemoTable I just created with the elements inside the shaperange array. I can verify that this works if I start move things around. It will successfully update the Top and Left properties of the shapes that have been displaced.
Problem/Challenge/Issue:
Then I expanded the code, so it would identify if a shape has been deleted. As you see in my code, the fourth row in my table (Table Index = 4) should be the same (thus have the same shape ID) as the third element in the ShapeRange array. However if the third shape is deleted, the array get shrunk, which means the third element in the new (updated automaically) shapeRange array is the fourth element in the old array. This is useful, because then you can use this to figure out if a shape has been deleted or not. If the ID associated with TabeIndex = 4 is the same as Shape Index = 3, then that means that the object described by TableIndex = 4 has been deleted and the Shape associate with Shape Index = 3 should be the same as the one referenced by Table Index = 5 (the next shape). That's why, I added ShapeIndex = ShapeIndex - 1.
Make the story short, this works sometimes, but the other times it's not accurate. Last night I deleted 20 shapes and ran the sub. It told me that 17 objects were deleted. I spend hours looking the results and debugging the code, but found nothing. This evening, I ran the code again after deleting 15 objects. Here is my updated table:
Updated Demo Table
Those red lines mean that that row (particular shape) has been deleted. In this case, I deleted 15 shapes, but it only shows that only 12 shapes have been deleted. Obviously this not right. As I said earlier, it happened last night too. It's not consistent at all. To prove this, I used a similar code as my CreateDemMap sub. Basically, it goes through each objects in the worksheet and make a table just like before. If everything would've gone right, this table should be exactly the same as my Demo Table (assuming if I delete those red rows). It's NOT!
New Table For Checking
The new table I extracted from the ShapeRange array tells me that there are 70 shapes in the array (15 were deleted which is the correct number), but in my DemoTable, only 12 rows were highlighted as red. Why is this happening? Last night, I deleted a particular shape with a specific shape ID. By doing this, I was sure that that shape object would not be in the ShapeRange Array. However, when I was debugging, I realized that wasn't the case. The object was gone from my screen, but its shape ID (and consequently the shape itself) was still in the ShapeRange Array. Why is VBA Excel acting like this? Can someone help me please?
It's really hard to understand all your code - but I think your problem is because you're ending your loop too early. It runs until ShapeNum which is the number of shapes you have in your sheet. When you delete some shapes, this number is lower than the number of entries in your table and the last entries in the table are not checked.

Excel VBA Listrow to Array

I have the below snippit for excel 2013 VBA
For Each r In rr
If Not r.Range.Height = 0 Then
FNum = FNum + 1
ReDim Preserve testArr(1 To FNum, 1 To 23)
testArr(FNum) = r
End If
Next r
My goal is to get all the visible rows from a filtered table into an array.
The table can be any number of rows, but always 23 columns.
I found that the height will be zero if it is hidden. But for the life of me, I cannot figure out how to get the entire row into the array.
r = listrow
rr = listrows
YES, I know a looping redim sucks.
SpecialCells(xlCellTypeVisible)
doesnt work either because it stops at the first hidden row/column.
I may just dump the entire table into the array and then filter the array. I havent figured out how to pull the active filter from the table to apply it, but I havent looked deeply into that yet. Thats what I will be doing now, because I am stuck for the other way.
Any and all advice is welcome.
DM
To avoid REDIM or double loops you can use something like Application.WorksheetFunction.Subtotal(3, Range("A2:A500000")) to quickly count the number of visible rows.
See this question
I define my Target range using .SpecialCells(xlCellTypeVisible). Target.Cells.Count / Target.Columns.Count will give you the row count. Finally I iterate over the cells in the Target range incrementing my counters based off of the Target.Columns.Count.
Public Sub FilteredArray()
Dim Data As Variant, r As Range, Target As Range
Dim rowCount As Long, x As Long, y As Long
Set Target = WorkSheets("Sheet1").ListObjects("Table1").DataBodyRange.SpecialCells(xlCellTypeVisible)
If Not Target Is Nothing Then
rowCount = Target.Cells.Count / Target.Columns.Count
ReDim Data(1 To rowCount, 1 To Target.Columns.Count)
x = 1
For Each r In Target
y = y + 1
If y > Target.Columns.Count Then
x = x + 1
y = 1
End If
Data(x, y) = r.Value
Next
End If
End Sub
The code below will create an array for all the rows and store each of these into another array that will store all info in sheet:
Function RowsToArray()
Dim lastRow: lastRow = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim lastCol: lastCol = ActiveWorkbook.ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Dim newArr()
ReDim newArr(lastRow)
For r = 0 To lastRow - 1
Dim rowarr()
ReDim rowarr(lastCol)
For c = 0 To lastCol - 1
rowarr(c) = Cells(r + 1, c + 1).Value
Next c
newArr(r) = rowarr
Next r
End Function
Can you loop over the cells in rr rather than the rows? If so, as #SJR says, you can only Redim Preserve the final dimension, so we're going to have to switch your dimensions. You can then use r.EntireRow.Hidden to check if we're in a visible row and increase the bound of your array by one if we are.
The following assumes that your data starts in column A:
For Each r In rr
If Not r.EntireRow.Hidden Then
If r.Column = 1 Then
If UBound(testArr, 2) = 0 Then
ReDim testArr(1 To 23, 1 To 1)
Else
ReDim Preserve testArr(1 To 23, 1 To UBound(testArr, 2) + 1)
End If
End If
testArr(r.Column, UBound(testArr, 2)) = r
End If
Next r
Edit:
Alternatively, you can keep using ListRows, but loop through twice, once to set the bounds of your array, and once to fill the array (which will have its own internal loop to run through the row...):
For Each r In rr
If Not r.Range.Height = 0 Then
Fnum = Fnum + 1
ReDim testArr(1 To Fnum, 1 To 3)
End If
Next r
Fnum = 0
For Each r In rr
If Not r.Range.RowHeight = 0 Then
Fnum = Fnum + 1
dumarray = r.Range
For i = 1 To 3
testArr(Fnum, i) = dumarray(1, i)
Next i
End If
Next r
Thanks all, a combo of answers led me to: (not very elegant, but quick)
For Each r In rr
If Not r.Range.Height = 0 Then
TNum = TNum + 1
End If
Next r
ReDim testArr(TNum, 23)
For Each r In rr
If Not r.Range.Height = 0 Then
FNum = FNum + 1
For i = 1 To 23
testArr(FNum, i) = r.Range.Cells(, i)
Next i
End If
Next r

data in arraylist not displayed correctly. instead displays "System.Collections.ArrayList" - vb.net

Can anyone please help, tell me why the data from database did not display in the rows? Instead "System.Collections.ArrayList" and "System.Data.DataRow" are displayed.
Dim myArray(4, 4) As String
For Each dtrow As DataRow In dt.Rows
list.Add(dtrow)
Next
For i = 0 To myArray.GetUpperBound(0)
If i = 0 Then
html.Append("<tr>")
ElseIf (i > 0 And i < 5) Then
html.Append("</tr>")
html.Append("<tr>")
For j = 0 To myArray.GetUpperBound(1)
Dim no = 0
'insert the code i mentioned below here'
no += 1
Next ' j'
End If ' if in i'
Next ' i
When i tried running using this 1 line below inserted to the above code, it displays System.Collections.ArrayList in the rows.
html.Append(list)
But when i tried running using this 1 line below inserted to the above code, it displays System.Data.DataRow in the rows.
html.Append(list(no))
========================================================================
Another method i tried, when i tried running using this line "html.Append(dt.Rows.Item(0)(0))" , it displays the correct data, but when i tried to do a loop to increase the number of columns and rows, it shows the same value of data. as though as the 'rw' and 'col' loop didnt work.
For j = 0 To myArray.GetUpperBound(1)
Dim no = 0
For rw = 0 To 5
Dim rno = 0
For col = 0 To 5
Dim cno = 0
no += 1
html.Append(dt.Rows.Item(rno)(cno))
cno += 1
Next
rno += 1
Next
Next 'j'
You already got a correct result when you used html.Append(dt.Rows.Item(0)(0)) - now you need write correct loop.
Noticed that you have DataTable instance - use this for looping through all rows and columns
For Each row As DataRow in dt.Rows
html.Append("<tr>")
For Each column in dt.Columns
html.Append("<td>")
html.Append(row(column.Ordinal))
html.Append("</td>")
End For
html.Append("</tr>")
End For
When working with xml I like using LINQ to Xml with XElement type, with those I can be sure that my xml structure is correct during compiling.
Visual basic have a nice feature which c# does not - XML Literals (Visual Basic)
Dim table As XElement = <table></table>
For Each row As DataRow in dt.Rows
Dim tr As XElement = <tr></tr>
For Each column in dt.Columns
Dim td As XElement = <td></td>
td.Value = row(column.Ordinal).ToString()
tr.Add(td)
End For
table.Add(tr)
End For

multiline text box to 2d array

How would I go about inserting the following input in to a 2d array or if required for the same effect a different kind of array.
abcd
efgh
ijkl
and when I click a button my array rotates 90 degrees to the right or left (if chosen) I've been thinking about it for about an hour I tried a few things but I'm totally new at VB.net
example using numbers instead:
1 2 3
4 5 6
7 8 9
rotated:
7 4 1
8 5 2
9 6 3
and so on
This might get you started You would want to dynamically set the upper bounds for the "rows" and "columns". This outputs it to a text box, but it would be easy enough to assign the variable to a new array.
Dim arr(3, 3) As String
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim i As Integer = 1
For row As Integer = 0 To 2
For col As Integer = 0 To 2
arr(row, col) = i
i += 1
Next
Next
End Sub
Public Sub showStraight()
TextBox1.Text = ""
For row As Integer = 0 To 2
Dim line As String = ""
For col As Integer = 0 To 2
line += arr(row, col)
Next
TextBox1.Text += line & vbNewLine
line = ""
Next
End Sub Public Sub showRotated()
TextBox1.Text = ""
For col As Integer = 0 To 2
Dim line As String = ""
For row As Integer = 2 To 0 Step -1
line += arr(row, col)
Next
TextBox1.Text += line & vbNewLine
line = ""
Next
End Sub

Resources