Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 55
Default Select rows that are 'blinking'

Hello,

Small question :).

As part of a module some field/records are 'selected' and they are 'blinking' (flashing) because they are not realy selected as when you select row(s) on the left site when you select complete rows with your mouse.

Info: Those 'blinking' records stopped blinking when you push the escape button or using the macro 'application.CutCopyMode=False'.

I like to get the solution that the rows of those 'blinking' ones gonna selected as a real active selected row(s).

Should be simple,..... but cant find the solution so quick :(.

regards,
Johan
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 55
Default Select rows that are 'blinking'


Sub CopyRows()

Dim srcbk As Workbook, srcsht As Worksheet, cel As Range

Dim tgtbk As Workbook, flag As Boolean, L0, L1, wrk As String
ReDim working(0) As String

Set srcbk = ActiveWorkbook
Set srcsht = ActiveSheet
'Find the data.

working(0) = "A" & ActiveCell.Row

For Each cel In Selection.Cells
For L0 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
'Case-sensitive.
If Cells(L0, 1).Value = Cells(cel.Row, 1).Value Then

flag = False
For L1 = 0 To UBound(working)
If working(L1) = "A" & L0 Then flag = True
Next
If Not flag Then
ReDim Preserve working(UBound(working) + 1)
working(UBound(working)) = "A" & L0
End If
End If
Next
Next

'This assumes that the workbook is entered as a string value
'(e.g. literally "C:\Apps\File1.xls"), not an Excel reference.
On Error Resume Next

Set tgtbk = Workbooks.Open(Sheets("Sheets1").Range("F2").Value ) 'Location of File1

On Error GoTo 0
If Not (tgtbk Is Nothing) Then
tgtbk.Activate

'Out with the old and in with the new.
Range("A2:A" & _
Cells.SpecialCells(xlCellTypeLastCell).Row).Entire Row.Delete

wrk = Join$(working, ",")
srcsht.Range(wrk).EntireRow.Copy

Range("A2").Select
ActiveSheet.Paste
tgtbk.Save
tgtbk.Close

'Kolom X bevat de Sdl Upload datum

srcsht.Range(wrk).EntireRow.Copy

For Each cel In Range(Replace$(wrk, "A", "X")).Cells

'cel.Value = Date
cel.Value = DateValue(Now) & " / " & TimeValue(Now)
Next
End If

Set cel = Nothing
Set srcsht = Nothing
Set tgtbk = Nothing
Set srcbk = Nothing

'NOW THE MACRO COMES BACK IN THE SHEET WERE IT BEFORE COPIEED THE SELECTED ROWS FROM TO THE OTHER FILE.
'THE ROWS THAT ARE SELECTED ARE BLINKING/FLASHING BU NOT REALLY SELECTED FOR A FURTHER ACTION.
'I NEED TO SELECT THOSE ROWS AS REAL SELECTED AS WHEN YOU SELECT WHOLE ROWS ON THE LEFT HEADINGS.
'NOW I WANT TO RUN THE NEXT MODULE I GET FROM CLAUS, BUT THAT NEEDS SELECTED ROWS :)

End Sub



Sub GetMessage()
Dim rngC As Range
Dim varEmpty() As Variant
Dim n As Long, i As Long
Dim myStr As String

For Each rngC In Intersect(Range("L:L"), Selection)
If Len(rngC) = 0 Then
i = i + 1
ReDim Preserve varEmpty(n)
varEmpty(n) = rngC.Address(0, 0)
n = n + 1
End If
Next
Select Case i
Case 0
Exit Sub
Case 1
myStr = varEmpty(0)
Case Else
myStr = Join(varEmpty, Chr(10))
End Select

MsgBox "Incomplete data in column K." & vbNewLine & "." & vbNewLine & "Ttl empty records = " & i & " st." & vbNewLine & "That are the records" & Chr(10) & myStr & vbNewLine & "." & vbNewLine & "Solve those !." & vbNewLine & "."

End Sub
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 55
Default Select rows that are 'blinking'

Oke, some explanation.

The first module;
1) Active field is on or more cells. Those could be selected by the user in a range, but it could be also separated selected fields with the CTRL option.
2) The module looks for those active cells in column A and select all rows that have the same data in column A as the active cells in column A (info; Column A is allways sorted).
3) The module copied those records to another file/sheet (after first emptying those file/sheet) and fills in column X the data/time of the copy action, so the user can see that those ones are copied.

The second module;
This should be a follow up action of the first module.
If in the selection of bullit 3, in column L no data was registrated, then a message should popup with those information (= records xxx were empty).


regards, Johan (and thanks for helping me out !!)





  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Select rows that are 'blinking'

Hi Johan,

Am Sat, 26 Nov 2016 04:53:57 -0800 (PST) schrieb :

The first module;
1) Active field is on or more cells. Those could be selected by the user in a range, but it could be also separated selected fields with the CTRL option.
2) The module looks for those active cells in column A and select all rows that have the same data in column A as the active cells in column A (info; Column A is allways sorted).
3) The module copied those records to another file/sheet (after first emptying those file/sheet) and fills in column X the data/time of the copy action, so the user can see that those ones are copied.


try following macro. Modify the sheet names where necessary:

Sub CopyRows2()
Dim wshS As Worksheet, wshT As Worksheet
Dim wbkS As Workbook, wbkT As Workbook
Dim varFilter As Variant, varTmp() As String
Dim myDic As Object
Dim i As Long, LrowS As Long, LRowT As Long
Dim n As Long, LCol As Long
Dim rngC As Range
Dim myPath As String

Set wbkS = ActiveWorkbook
Set wshS = wbkS.ActiveSheet

With wshS
LrowS = .Cells(.Rows.Count, "A").End(xlUp).Row
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Each rngC In Intersect(Selection, .Columns("A"))
ReDim Preserve varTmp(n)
varTmp(n) = rngC
n = n + 1
Next

Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(varTmp) To UBound(varTmp)
myDic(varTmp(i)) = varTmp(i)
Next
varFilter = myDic.items
.UsedRange.AutoFilter field:=1, Criteria1:=varFilter,
Operator:=xlFilterValues
myPath = wbkS.Sheets("Sheet1").Range("F2")
If Dir(myPath) < "" Then
Set wbkT = Workbooks.Open(myPath)
Set wshT = wbkT.Sheets("Sheet1")
wshT.UsedRange.ClearContents
Else
MsgBox "Workbook not available. Macro is canceled"
End If
.Range(.Cells(2, 1), .Cells(LrowS, LCol)).Copy wshT.Range("A2")
.AutoFilterMode = False
End With
With wshT
LRowT = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("X2:X" & LRowT) = Format(Now, "dd.Mm.yyyy \/ hh:mm:ss")
End With
wbkT.Close savechanges:=True
End Sub


Regards
Claus B.
--
Windows10
Office 2016
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Select rows that are 'blinking'

Hi Johan,

Am Sat, 26 Nov 2016 14:42:45 +0100 schrieb Claus Busch:

try following macro. Modify the sheet names where necessary:

Sub CopyRows2()


if you want it case sensitive then try:

Sub CopyRows3()
Dim wshS As Worksheet, wshT As Worksheet
Dim wbkS As Workbook, wbkT As Workbook
Dim varFilter As Variant, varTmp() As String
Dim varData As Variant, varRows() As Variant
Dim myDic As Object
Dim i As Long, LrowS As Long, n As Long, j As Long, LCol As Long
Dim rngC As Range
Dim myPath As String

Set wbkS = ActiveWorkbook
Set wshS = wbkS.ActiveSheet
Application.ScreenUpdating = False

With wshS
LrowS = .Cells(.Rows.Count, "A").End(xlUp).Row
varData = .Range("A1:A" & LrowS)
For Each rngC In Intersect(Selection, .Columns("A"))
ReDim Preserve varTmp(n)
varTmp(n) = rngC
n = n + 1
Next

Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(varTmp) To UBound(varTmp)
myDic(varTmp(i)) = varTmp(i)
Next
varFilter = myDic.items
n = 0
For i = LBound(varFilter) To UBound(varFilter)
For j = 2 To UBound(varData)
If StrComp(varData(j, 1), varFilter(i), vbBinaryCompare) = 0 Then
ReDim Preserve varRows(n)
varRows(n) = j
n = n + 1
End If
Next
Next
myPath = wbkS.Sheets("Sheet1").Range("F2")
If Dir(myPath) < "" Then
Set wbkT = Workbooks.Open(myPath)
Set wshT = wbkT.Sheets("Sheet1")
wshT.UsedRange.ClearContents
Else
MsgBox "Workbook not available. Macro is canceled"
End If
n = 2
For i = LBound(varRows) To UBound(varRows)
.Rows(varRows(i)).Copy wshT.Cells(n, 1)
n = n + 1
Next
End With
wshT.Range("X2").Resize(UBound(varRows) + 1) = Format(Now, "dd.Mm.yyyy \/ hh:mm:ss")

wbkT.Close savechanges:=True
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Windows10
Office 2016
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can i randomly select 780 rows from 4000 rows of data bbb Excel Worksheet Functions 2 July 6th 07 08:21 PM
Trying to select rows Arne Hegefors Excel Programming 4 July 20th 06 05:22 PM
select rows [email protected] Excel Worksheet Functions 1 March 1st 06 04:57 AM
select block of rows w/data between blank rows Janna Excel Programming 6 February 13th 05 03:45 AM
Unable to select rows in the repeat rows on top option Noppie Excel Discussion (Misc queries) 2 December 28th 04 04:17 PM


All times are GMT +1. The time now is 02:18 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"